You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
972 lines
25 KiB
972 lines
25 KiB
#include "forth_internal.h"
|
|
|
|
static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
ENSURE_STATE(FH_STATE_INTERPRET);
|
|
|
|
char *wordname = NULL;
|
|
size_t namelen = 0;
|
|
fh_input_consume_spaces(fh);
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen));
|
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0);
|
|
|
|
uint32_t ptr;
|
|
fh_align(fh);
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
|
|
|
|
LOG("New word \"%.*s\", head at 0x%08x, exec at 0x%08x", (int) namelen, wordname, ptr, fh->here);
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr);
|
|
if (!new_word) { return FH_ERR_INTERNAL; }
|
|
new_word->previous = fh->dict_last;
|
|
new_word->param = fh->here;
|
|
new_word->handler = w_user_word;
|
|
strncpy(new_word->name, wordname, namelen);
|
|
new_word->name[namelen] = 0;
|
|
new_word->flags = WORDFLAG_WORD | WORDFLAG_HIDDEN;
|
|
|
|
fh->dict_last = ptr;
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error rt_marker(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
LOG("Restore dict to landmark sate \"%s\"", w->name);
|
|
fh->dict_last = w->param;
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error rt_defer(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
uint32_t defered = w->param;
|
|
if (defered == MAGICADDR_UNRESOLVED) {
|
|
LOGE("Exec DEFER name without assigned xt!");
|
|
return FH_ERR_BAD_DEFER;
|
|
}
|
|
|
|
return fh_handle_word(fh, defered);
|
|
}
|
|
|
|
static enum fh_error w_marker(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
ENSURE_STATE(FH_STATE_INTERPRET);
|
|
|
|
char *wordname = NULL;
|
|
size_t namelen = 0;
|
|
fh_input_consume_spaces(fh);
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen));
|
|
LOG("Marker name: %.*s", (int) namelen, wordname);
|
|
|
|
uint32_t ptr;
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr);
|
|
if (!new_word) { return FH_ERR_INTERNAL; }
|
|
new_word->previous = fh->dict_last;
|
|
new_word->param = fh->dict_last;
|
|
new_word->handler = rt_marker;
|
|
strncpy(new_word->name, wordname, namelen);
|
|
new_word->name[namelen] = 0;
|
|
new_word->flags = WORDFLAG_WORD;
|
|
|
|
fh->dict_last = ptr;
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_colon_noname(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
ENSURE_STATE(FH_STATE_INTERPRET);
|
|
|
|
LOG("Starting noname compilation");
|
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0);
|
|
|
|
uint32_t ptr;
|
|
fh_align(fh);
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr);
|
|
if (!new_word) { return FH_ERR_INTERNAL; }
|
|
//new_word->previous = MAGICADDR_DICTFIRST;
|
|
new_word->previous = fh->dict_last;
|
|
new_word->param = fh->here;
|
|
new_word->handler = w_user_word;
|
|
new_word->name[0] = 0; // no name, really
|
|
new_word->flags = WORDFLAG_WORD | WORDFLAG_HIDDEN;
|
|
|
|
TRY(ds_push(fh, ptr)); // TODO maybe should do this at semicolon?
|
|
|
|
fh->dict_last = ptr;
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_does(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
if (fh->executing_compiled) {
|
|
struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last);
|
|
if (!last_word) { return FH_ERR_INTERNAL; }
|
|
last_word->param = fh->execptr + INSTR_SIZE;
|
|
last_word->handler = w_user_word;
|
|
last_word->flags = WORDFLAG_WORD | WORDFLAG_CREATED;
|
|
return FH_OK;
|
|
}
|
|
|
|
if (fh->state == FH_STATE_COMPILE) {
|
|
TRY(fh_put_instr(fh, FH_INSTR_WORD, (void *) w - (void *) &fh->heap[0])); // call the DOES word
|
|
TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 1)); // synthetic exit so we dont also run the "postponed" DOES> content
|
|
return FH_OK;
|
|
}
|
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0);
|
|
|
|
struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last);
|
|
if (!last_word) { return FH_ERR_INTERNAL; }
|
|
|
|
last_word->handler = w_user_word;
|
|
last_word->param = fh->here;
|
|
last_word->flags = WORDFLAG_WORD | WORDFLAG_CREATED;
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_forget(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
ENSURE_STATE(FH_STATE_INTERPRET);
|
|
|
|
char *wordname = NULL;
|
|
size_t namelen = 0;
|
|
fh_input_consume_spaces(fh);
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen));
|
|
LOG("Name to forget: %.*s", (int) namelen, wordname);
|
|
|
|
uint32_t addr;
|
|
TRY(fh_find_word(fh, wordname, namelen, &addr));
|
|
|
|
struct fh_word_s *removedword = fh_word_at(fh, addr);
|
|
if (!removedword) { return FH_ERR_INTERNAL; }
|
|
fh->dict_last = removedword->previous;
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
ENSURE_STATE(FH_STATE_COMPILE);
|
|
|
|
char *wordname;
|
|
size_t namelen = 0;
|
|
fh_input_consume_spaces(fh);
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen));
|
|
TRY(fh_postpone_word(fh, wordname, namelen));
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error rt_read_value(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
enum fh_error rv;
|
|
TRY(ds_push(fh, w->param));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error rt_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
enum fh_error rv;
|
|
uint32_t addr = (void *) &w->param - (void *) &fh->heap[0]; // this is ugly
|
|
TRY(ds_push(fh, addr));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
bool is_value = w->param == 1;
|
|
bool is_const = w->param == 2;
|
|
|
|
if (is_const && fh->state == FH_STATE_COMPILE) {
|
|
uint32_t wordaddr = (void *) w - (void *) &fh->heap[0]; // this is ugly
|
|
TRY(fh_put_instr(fh, FH_INSTR_WORD, wordaddr));
|
|
return FH_OK;
|
|
}
|
|
|
|
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;
|
|
uint32_t value = 0;
|
|
|
|
if (is_value || is_const) {
|
|
TRY(ds_pop(fh, &value));
|
|
}
|
|
|
|
fh_align(fh);
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr);
|
|
if (!new_word) { return FH_ERR_INTERNAL; }
|
|
new_word->previous = fh->dict_last;
|
|
new_word->param = value;
|
|
new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr;
|
|
strncpy(new_word->name, wordname, namelen);
|
|
new_word->name[namelen] = 0;
|
|
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;
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_to(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
if (fh->state == FH_STATE_INTERPRET) {
|
|
uint32_t value;
|
|
TRY(ds_pop(fh, &value));
|
|
|
|
char *wordname;
|
|
size_t namelen = 0;
|
|
uint32_t waddr;
|
|
fh_input_consume_spaces(fh);
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen));
|
|
TRY(fh_find_word(fh, wordname, namelen, &waddr));
|
|
|
|
struct fh_word_s *ww = fh_word_at(fh, waddr);
|
|
if (!ww) { return FH_ERR_INTERNAL; }
|
|
|
|
if (ww->flags & WORDFLAG_WORD) {
|
|
LOGE("Cannot assign to dictionary word param field!");
|
|
return FH_ERR_NOT_APPLICABLE;
|
|
}
|
|
|
|
if (ww->flags & WORDFLAG_CONSTANT) {
|
|
LOGE("Cannot assign to constant!");
|
|
return FH_ERR_NOT_APPLICABLE;
|
|
}
|
|
|
|
ww->param = value;
|
|
} else if (fh->state == FH_STATE_COMPILE) {
|
|
// immediate
|
|
char *wordname;
|
|
size_t namelen = 0;
|
|
uint32_t waddr;
|
|
fh_input_consume_spaces(fh);
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen));
|
|
TRY(fh_find_word(fh, wordname, namelen, &waddr));
|
|
|
|
TRY(fh_put_instr(fh, FH_INSTR_TO, waddr));
|
|
}
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_leftbracket(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
ENSURE_STATE(FH_STATE_COMPILE);
|
|
fh_setstate(fh, FH_STATE_INTERPRET, 0);
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_rightbracket(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
ENSURE_STATE(FH_STATE_INTERPRET);
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0);
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_source(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
TRY(ds_push(fh, fh->inputaddr));
|
|
TRY(ds_push(fh, fh->inputlen));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_literal(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
ENSURE_STATE(FH_STATE_COMPILE);
|
|
|
|
uint32_t val;
|
|
TRY(ds_pop(fh, &val));
|
|
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, val));
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s *w0)
|
|
{
|
|
(void) w0;
|
|
enum fh_error rv;
|
|
|
|
ENSURE_STATE(FH_STATE_COMPILE);
|
|
TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 0));
|
|
|
|
/* Return to interpret state */
|
|
fh_setstate(fh, FH_STATE_INTERPRET, 0);
|
|
|
|
// XXX if there was another definition previously and it was used in some other compiled function,
|
|
// that old implementation will still be called.
|
|
|
|
// unhide the entry, if hidden (colon does this to make the word unresolvable before it's finished)
|
|
struct fh_word_s *ww = fh_word_at(fh, fh->dict_last);
|
|
if (ww && (ww->flags & WORDFLAG_WORD) && ww->name[0] != 0) {
|
|
ww->flags &= ~WORDFLAG_HIDDEN;
|
|
}
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_compile_comma(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
uint32_t xt;
|
|
TRY(ds_pop(fh, &xt));
|
|
TRY(fh_put_instr(fh, FH_INSTR_WORD, xt));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
if (fh->dict_last == 0) {
|
|
LOGE("Dict is empty, cannot modify previous word!");
|
|
return FH_ERR_INVALID_STATE;
|
|
}
|
|
|
|
struct fh_word_s *word = fh_word_at(fh, fh->dict_last);
|
|
if (!word) { return FH_ERR_INTERNAL; }
|
|
word->flags |= WORDFLAG_IMMEDIATE;
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_backslash(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
fh_setsubstate(fh, FH_SUBSTATE_LINE_COMMENT);
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
fh_setsubstate(fh, FH_SUBSTATE_PAREN_COMMENT);
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error wp_char(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 = NULL;
|
|
size_t namelen = 0;
|
|
fh_input_consume_spaces(fh);
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen));
|
|
|
|
char c = (char) *wordname;
|
|
if (bracketed) {
|
|
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, c));
|
|
} else {
|
|
TRY(ds_push(fh, c));
|
|
}
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_depth(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
TRY(ds_push(fh, fh->data_stack_top));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_unused(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
TRY(ds_push(fh, HEAP_SIZE - fh->here));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_to_in(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
TRY(ds_push(fh, MAGICADDR_INPTR));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_to_body(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
uint32_t xt;
|
|
TRY(ds_pop(fh, &xt)); // xt is now a dict entry (hopefully)
|
|
TRY(ds_push(fh, xt + DICTWORD_SIZE));
|
|
return FH_OK;
|
|
}
|
|
|
|
static bool chartest_equals_or_end(char c, void *param)
|
|
{
|
|
char cc = (char) *(uint32_t *) param;
|
|
return c == cc || c == 0;
|
|
}
|
|
|
|
|
|
static enum fh_error w_word(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
uint32_t ch;
|
|
TRY(ds_pop(fh, &ch));
|
|
if (ch > 0xFF) {
|
|
LOGE("Char out of ASCII bounds!");
|
|
return FH_ERR_NOT_APPLICABLE;
|
|
}
|
|
|
|
fh_input_consume_matching(fh, chartest_equals_or_end, &ch);
|
|
|
|
char *out;
|
|
size_t len;
|
|
fh_input_read_delimited(fh, &out, &len, chartest_equals_or_end, &ch);
|
|
if (len >= WORDBUF_SIZE) {
|
|
LOGE("WORD parsed string too long");
|
|
return FH_ERR_NAME_TOO_LONG;
|
|
}
|
|
|
|
fh_store_char(fh, WORDBUF_ADDR, (char) len);
|
|
fh_heap_copyptr(fh, WORDBUF_ADDR + 1, out, len);
|
|
|
|
LOG("Word found: \"%.*s\"", (int) len, out);
|
|
|
|
TRY(ds_push(fh, WORDBUF_ADDR));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_count(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
uint32_t caddr;
|
|
TRY(ds_pop(fh, &caddr));
|
|
|
|
uint8_t len;
|
|
TRY(fh_fetch_char(fh, caddr, (char *) &len));
|
|
TRY(ds_push(fh, caddr + 1));
|
|
TRY(ds_push(fh, len));
|
|
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);
|
|
if (!new_word) { return FH_ERR_INTERNAL; }
|
|
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_defer(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;
|
|
|
|
fh_align(fh);
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr);
|
|
if (!new_word) { return FH_ERR_INTERNAL; }
|
|
new_word->previous = fh->dict_last;
|
|
new_word->param = MAGICADDR_UNRESOLVED;
|
|
new_word->handler = rt_defer;
|
|
strncpy(new_word->name, wordname, namelen);
|
|
new_word->name[namelen] = 0;
|
|
new_word->flags = WORDFLAG_BUILTIN | WORDFLAG_DEFER;
|
|
|
|
fh->dict_last = ptr;
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_defer_store(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
uint32_t xt1, xt2;
|
|
TRY(ds_pop(fh, &xt1));
|
|
TRY(ds_pop(fh, &xt2));
|
|
|
|
struct fh_word_s *ww = fh_word_at(fh, xt1);
|
|
if (0 == (ww->flags & WORDFLAG_DEFER)) {
|
|
LOGE("%s is not DEFER!", ww->name);
|
|
return FH_ERR_BAD_DEFER;
|
|
}
|
|
|
|
ww->param = xt2;
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_defer_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
uint32_t xt1;
|
|
TRY(ds_pop(fh, &xt1));
|
|
|
|
struct fh_word_s *ww = fh_word_at(fh, xt1);
|
|
if (0 == (ww->flags & WORDFLAG_DEFER)) {
|
|
LOGE("%s is not DEFER!", ww->name);
|
|
return FH_ERR_BAD_DEFER;
|
|
}
|
|
|
|
TRY(ds_push(fh, ww->param));
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_is(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
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;
|
|
}
|
|
|
|
struct fh_word_s *ww = fh_word_at(fh, addr);
|
|
if (0 == (ww->flags & WORDFLAG_DEFER)) {
|
|
LOGE("%s is not DEFER!", ww->name);
|
|
return FH_ERR_BAD_DEFER;
|
|
}
|
|
|
|
if (fh->state == FH_STATE_COMPILE) {
|
|
TRY(fh_put_instr(fh, FH_INSTR_ISDEFER, addr));
|
|
} else {
|
|
TRY(ds_pop(fh, &ww->param));
|
|
}
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_action_of(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
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;
|
|
}
|
|
|
|
struct fh_word_s *ww = fh_word_at(fh, addr);
|
|
if (0 == (ww->flags & WORDFLAG_DEFER)) {
|
|
LOGE("%s is not DEFER!", ww->name);
|
|
return FH_ERR_BAD_DEFER;
|
|
}
|
|
|
|
if (fh->state == FH_STATE_COMPILE) {
|
|
TRY(fh_put_instr(fh, FH_INSTR_ACTIONOF, addr));
|
|
} else {
|
|
TRY(ds_push(fh, ww->param));
|
|
}
|
|
|
|
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);
|
|
if (!word) { return FH_ERR_INTERNAL; }
|
|
|
|
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) {
|
|
LOGE("Execute with bad addr");
|
|
return FH_ERR_NOT_APPLICABLE;
|
|
}
|
|
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_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));
|
|
return fh_runtime_start(fh, fh_create_input_from_string(fh_str_at(fh, addr), count, fh->input->cwd));
|
|
}
|
|
|
|
static enum fh_error w_save_input(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
fh->input->save_input(fh, fh->input);
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_restore_input(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
fh->input->restore_input(fh, fh->input);
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_included(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));
|
|
|
|
if (count > 99) {
|
|
LOGE("Filename too long for INCLUDED");
|
|
return FH_ERR_NOT_APPLICABLE;
|
|
}
|
|
|
|
char tmp[100];
|
|
strncpy(tmp, fh_str_at(fh, addr), count);
|
|
tmp[count] = 0;
|
|
|
|
fh_runtime_start(fh, fh_create_input_from_filename(tmp));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_include(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
char *wordname;
|
|
size_t namelen = 0;
|
|
fh_input_consume_spaces(fh);
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen));
|
|
|
|
if (namelen > 99) {
|
|
LOGE("Filename too long for INCLUDED");
|
|
return FH_ERR_NOT_APPLICABLE;
|
|
}
|
|
|
|
char tmp[100];
|
|
strncpy(tmp, wordname, namelen);
|
|
tmp[namelen] = 0;
|
|
|
|
fh_runtime_start(fh, fh_create_input_from_filename(tmp));
|
|
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);
|
|
if (!str) {
|
|
LOGE("Bad string addr for env query!");
|
|
return FH_ERR_NOT_APPLICABLE;
|
|
}
|
|
|
|
LOG("Test environment \"%.*s\"", len, str);
|
|
|
|
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)));
|
|
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)) {
|
|
TRY(ds_push_dw(fh, 0x7FFFFFFFFFFFFFFFULL));
|
|
} else if (EQ(str, "MAX-UD", len)) {
|
|
TRY(ds_push_dw(fh, 0xFFFFFFFFFFFFFFFFULL));
|
|
} 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));
|
|
}
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_parse(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
uint32_t ch;
|
|
TRY(ds_pop(fh, &ch));
|
|
if (ch > 0xFF) {
|
|
LOGE("Char out of ASCII bounds!");
|
|
return FH_ERR_NOT_APPLICABLE;
|
|
}
|
|
|
|
char *out;
|
|
size_t len;
|
|
fh_input_read_delimited(fh, &out, &len, chartest_equals_or_end, &ch);
|
|
if (len >= WORDBUF_SIZE) {
|
|
LOGE("PARSE parsed string too long: %d", len);
|
|
return FH_ERR_NAME_TOO_LONG;
|
|
}
|
|
|
|
LOG("Parsed %d", len);
|
|
|
|
TRY(ds_push(fh, (void*) out - (void*) &fh->heap[0]));
|
|
TRY(ds_push(fh, len));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_parse_name(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
|
|
fh_input_consume_spaces(fh);
|
|
|
|
char * ww;
|
|
size_t len;
|
|
TRY(fh_input_read_word(fh, &ww, &len));
|
|
|
|
LOG("Parsed %.*s", len, ww);
|
|
|
|
TRY(ds_push(fh, (void*) ww - (void*) &fh->heap[0]));
|
|
TRY(ds_push(fh, len));
|
|
return FH_OK;
|
|
}
|
|
|
|
static enum fh_error w_refill(struct fh_thread_s *fh, const struct fh_word_s *w)
|
|
{
|
|
(void) w;
|
|
enum fh_error rv;
|
|
bool suc = fh->input->refill_input_buffer(fh, fh->input);
|
|
if (fh->input->source_id == -1) suc = false; // string always says it can't refill
|
|
TRY(ds_push(fh, TOBOOL(suc)));
|
|
return FH_OK;
|
|
}
|
|
|
|
const struct name_and_handler fh_builtins_meta[] = {
|
|
{"depth", w_depth, 0, 0},
|
|
{"unused", w_unused, 0, 0},
|
|
{">in", w_to_in, 0, 0},
|
|
{">body", w_to_body, 0, 0},
|
|
{":", w_colon, 0, 0},
|
|
{":noname", w_colon_noname, 0, 0},
|
|
{"does>", w_does, 1, 0},
|
|
{";", w_semicolon, 1, 0},
|
|
{"forget", w_forget, 1, 0},
|
|
{"\\", w_backslash, 1, 0}, // line comment
|
|
{"(", w_paren, 1, 0}, // enclosed comment
|
|
{"immediate", w_immediate, 0, 0},
|
|
{"postpone", w_postpone, 1, 0},
|
|
{"[", w_leftbracket, 1, 0},
|
|
{"]", w_rightbracket, 1, 0},
|
|
{"source", w_source, 0, 0},
|
|
{"literal", w_literal, 1, 0},
|
|
{"char", wp_char, 0, 0},
|
|
{"[char]", wp_char, 1, 1},
|
|
{"to", w_to, 1, 0},
|
|
{"variable", wp_variable, 1, 0},
|
|
{"value", wp_variable, 1, 1},
|
|
{"constant", wp_variable, 1, 2},
|
|
{"word", w_word, 0, 0},
|
|
{"parse", w_parse, 0, 0},
|
|
{"parse-name", w_parse_name, 0, 0},
|
|
{"count", w_count, 0, 0},
|
|
{"create", w_create, 0, 0},
|
|
{"defer", w_defer, 0, 0},
|
|
{"defer!", w_defer_store, 0, 0},
|
|
{"defer@", w_defer_fetch, 0, 0},
|
|
{"action-of", w_action_of, 1, 0}, // imm because it has special compile behavior
|
|
{"is", w_is, 1, 0},
|
|
{"find", w_find, 0, 0},
|
|
{"'", wp_tick, 1, 0},
|
|
{"[']", wp_tick, 1, 1},
|
|
{"execute", w_execute, 0, 0},
|
|
{"save-input", w_save_input, 0, 0},
|
|
{"restore-input",w_restore_input, 0, 0},
|
|
{"environment?", w_env_query, 0, 0},
|
|
{"marker", w_marker, 0, 0},
|
|
{"compile,", w_compile_comma, 0, 0},
|
|
{"evaluate", w_evaluate, 0, 0},
|
|
{"included", w_included, 0, 0},
|
|
{"include", w_include, 0, 0},
|
|
{"refill", w_refill, 0, 0},
|
|
{ /* end marker */ }
|
|
};
|
|
|