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.
549 lines
15 KiB
549 lines
15 KiB
#include "forth_internal.h"
|
|
|
|
struct fh_global_s fh_globals = {};
|
|
|
|
/** State names */
|
|
static const char *statenames[FH_STATE_MAX] = {
|
|
[FH_STATE_INTERPRET] = "INTERPRET",
|
|
[FH_STATE_COMPILE] = "COMPILE",
|
|
[FH_STATE_QUIT] = "QUIT",
|
|
[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 */
|
|
const char *substatenames[FH_SUBSTATE_MAX] = {
|
|
[FH_SUBSTATE_NONE] = "NONE",
|
|
[FH_SUBSTATE_PAREN_COMMENT] = "PAREN_COMMENT",
|
|
[FH_SUBSTATE_LINE_COMMENT] = "LINE_COMMENT",
|
|
[FH_SUBSTATE_EXIT] = "EXIT",
|
|
[FH_SUBSTATE_SKIP_IF] = "SKIP_IF",
|
|
};
|
|
|
|
/** 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",
|
|
[FH_INSTR_ABORTSTR] = "ABORTSTR",
|
|
[FH_INSTR_ACTIONOF] = "ACTIONOF",
|
|
[FH_INSTR_ISDEFER] = "ISDEFER",
|
|
};
|
|
|
|
void fh_abort(struct fh_thread_s *fh) {
|
|
fh->data_stack_top = 0;
|
|
fh_quit(fh);
|
|
}
|
|
|
|
void fh_drop_to_interactive(struct fh_thread_s *fh) {
|
|
fh_input_teardown(fh);
|
|
|
|
fh_push_input(fh, fh_create_input_from_filestruct(stdin, NULL));
|
|
fh->return_stack_top = 0;
|
|
fh->execptr = MAGICADDR_EXEC_INTERACTIVE;
|
|
fh_globals.interactive = 1;
|
|
fh_setstate(fh, FH_STATE_INTERPRET, 0);
|
|
}
|
|
|
|
void fh_quit(struct fh_thread_s *fh) {
|
|
if (fh_globals.interactive || fh_globals.rescue) {
|
|
fh_drop_to_interactive(fh);
|
|
fh_setstate(fh, FH_STATE_QUIT, 0);
|
|
} else {
|
|
fh_setstate(fh, FH_STATE_SHUTDOWN, 0);
|
|
}
|
|
}
|
|
|
|
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. */
|
|
enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
|
|
{
|
|
enum fh_error rv;
|
|
|
|
fh_align(fh);
|
|
uint32_t ptr = fh->here;
|
|
|
|
TRY(fh_heap_put(fh, w, DICTWORD_SIZE));
|
|
|
|
//LOG("Added word \"%s\" at 0x%08x", w->name, ptr);
|
|
|
|
// thread it onto the linked list
|
|
struct fh_word_s *word = fh_word_at(fh, ptr);
|
|
if (!word) { return FH_ERR_INTERNAL; }
|
|
word->previous = fh->dict_last;
|
|
fh->dict_last = ptr;
|
|
|
|
return FH_OK;
|
|
}
|
|
|
|
/** Log current runtime state */
|
|
static void showstate(const struct fh_thread_s *fh)
|
|
{
|
|
if (fh->substate == 0) {
|
|
LOG("state -> %s", statenames[fh->state]);
|
|
} else {
|
|
LOG("state -> %s.%s", statenames[fh->state], substatenames[fh->substate]);
|
|
}
|
|
}
|
|
|
|
/** Set runtime state and sub-state */
|
|
void fh_setstate(struct fh_thread_s *fh, enum fh_state state, enum fh_substate substate)
|
|
{
|
|
fh->state = state;
|
|
fh->substate = substate;
|
|
showstate(fh);
|
|
}
|
|
|
|
/** Set runtime sub-state (state is unchanged) */
|
|
void fh_setsubstate(struct fh_thread_s *fh, enum fh_substate substate)
|
|
{
|
|
fh->substate = substate;
|
|
showstate(fh);
|
|
}
|
|
|
|
/** Execute a user word */
|
|
enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
|
|
{
|
|
enum fh_error rv;
|
|
const struct fh_word_s *w;
|
|
struct fh_word_s *w2;
|
|
|
|
fh->executing_compiled = 1;
|
|
|
|
w = w0;
|
|
call:
|
|
if (!w) { return FH_ERR_INTERNAL; }
|
|
|
|
LOG("\x1b[35mExec: Called user word: %s\x1b[m", w->name);
|
|
|
|
TRY(rs_push(fh, fh->execptr));
|
|
fh->execptr = w->param;
|
|
|
|
if ((WORDFLAG_WORD | WORDFLAG_CREATED) == (w->flags & (WORDFLAG_WORD | WORDFLAG_CREATED))) {
|
|
// push the >BODY addr if this is a CREATE'd word
|
|
TRY(ds_push(fh, word_addr(fh, w) + DICTWORD_SIZE));
|
|
}
|
|
|
|
instr:;
|
|
if (fh->state == FH_STATE_SHUTDOWN) {
|
|
return FH_OK;
|
|
}
|
|
if (fh->state == FH_STATE_QUIT) {
|
|
LOG("QUIT word exec");
|
|
/* abort or quit was called, return to interactive mode */
|
|
fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
|
|
return FH_OK;
|
|
}
|
|
// make sure it's aligned
|
|
fh->execptr = WORDALIGNED(fh->execptr);
|
|
|
|
if (fh->execptr == 0 || fh->execptr > fh->here) {
|
|
LOGE("Bad execptr value 0x%08x", fh->execptr);
|
|
return FH_ERR_ILLEGAL_FETCH;
|
|
}
|
|
|
|
const struct fh_instruction_s *instr = fh_instr_at(fh, fh->execptr);
|
|
if (!instr) {
|
|
LOGE("Execution pointer out of bounds!");
|
|
return FH_ERR_INTERNAL;
|
|
}
|
|
fh->execptr += INSTR_SIZE;
|
|
|
|
uint32_t strl;
|
|
uint32_t val, testval;
|
|
uint32_t limit, index;
|
|
|
|
LOG("0x%08x: Instr %s, 0x%08x", fh->execptr, instr_name(instr->kind), instr->data);
|
|
|
|
switch (instr->kind) {
|
|
case FH_INSTR_NUMBER:
|
|
TRY(ds_push(fh, instr->data));
|
|
goto instr;
|
|
|
|
case FH_INSTR_POSTPONED_WORD:
|
|
//if (fh->state == FH_STATE_COMPILE) {
|
|
w2 = fh_word_at(fh, instr->data);
|
|
if (!w2) {
|
|
LOGE("Postponed bad word addr!");
|
|
return FH_ERR_INTERNAL;
|
|
}
|
|
if (w2->flags & WORDFLAG_IMMEDIATE) {
|
|
goto call_w2;
|
|
// LOG("Call immediate postponed word: %s", w2->name);
|
|
// if (w2->flags & WORDFLAG_BUILTIN) {
|
|
// TRY(rs_push(fh, fh->execptr));
|
|
// }
|
|
// TRY(w2->handler(fh, w2));
|
|
// if (0 == (w2->flags & WORDFLAG_BUILTIN)) {
|
|
// TRY(rs_pop(fh, &fh->execptr));
|
|
// }
|
|
} else {
|
|
LOG("\x1b[35mExec: Add postponed word\x1b[m %s", w2->name);
|
|
TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data));
|
|
}
|
|
/*} else {
|
|
LOGE("Postpone in interpret mode!");
|
|
goto end;
|
|
}*/
|
|
goto instr;
|
|
|
|
case FH_INSTR_WORD:
|
|
w2 = fh_word_at(fh, instr->data);
|
|
if (!w2) {
|
|
LOGE("Instr bad word addr!");
|
|
return FH_ERR_INTERNAL;
|
|
}
|
|
call_w2:
|
|
if (w2->flags & WORDFLAG_BUILTIN) {
|
|
LOG("\x1b[35mExec: native-word \"%s\"\x1b[m", w2->name);
|
|
TRY(w2->handler(fh, w2));
|
|
if (fh->substate == FH_SUBSTATE_EXIT) {
|
|
fh_setsubstate(fh, 0);
|
|
LOG("Exec: early return");
|
|
TRY(rs_pop(fh, &fh->execptr));
|
|
if (fh->execptr == MAGICADDR_EXEC_INTERACTIVE) {
|
|
goto end;
|
|
}
|
|
}
|
|
goto instr;
|
|
} else {
|
|
LOG("\x1b[35mExec: user-word %s\x1b[m (CALL)", w2->name);
|
|
w = fh_word_at(fh, instr->data);
|
|
if (!w) {
|
|
LOGE("CALL instr bad word addr!");
|
|
return FH_ERR_INTERNAL;
|
|
}
|
|
goto call;
|
|
}
|
|
|
|
case FH_INSTR_JUMPZERO:
|
|
LOG("\x1b[35mExec: jump if zero -> 0x%08x\x1b[m", instr->data);
|
|
if (instr->data == MAGICADDR_UNRESOLVED) {
|
|
LOGE("Encountered unresolved jump!");
|
|
goto end;
|
|
}
|
|
|
|
TRY(ds_pop(fh, &val));
|
|
if (0 == val) {
|
|
LOG("Jumping");
|
|
fh->execptr = instr->data;
|
|
} else {
|
|
LOG("No jump");
|
|
}
|
|
goto instr;
|
|
|
|
case FH_INSTR_JUMP:
|
|
LOG("\x1b[35mExec: jump -> 0x%08x\x1b[m", instr->data);
|
|
if (instr->data == MAGICADDR_UNRESOLVED) {
|
|
LOGE("Encountered unresolved jump!");
|
|
goto end;
|
|
}
|
|
fh->execptr = instr->data;
|
|
goto instr;
|
|
|
|
case FH_INSTR_TO:
|
|
TRY(ds_pop(fh, &val));
|
|
w2 = fh_word_at(fh, instr->data);
|
|
if (!w2) {
|
|
LOGE("TO instr bad variable addr!");
|
|
return FH_ERR_INTERNAL;
|
|
}
|
|
LOG("\x1b[35mExec: %d TO %s\x1b[m", val, w2->name);
|
|
|
|
if (w2->flags & WORDFLAG_CONSTANT) {
|
|
LOGE("Cannot assign to constant!");
|
|
return FH_ERR_ILLEGAL_STORE;
|
|
}
|
|
|
|
w2->param = val;
|
|
goto instr;
|
|
|
|
case FH_INSTR_DO:
|
|
LOG("\x1b[35mExec: do\x1b[m");
|
|
TRY(ds_pop(fh, &index));
|
|
TRY(ds_pop(fh, &limit)); // just make sure it exists
|
|
TRY(fh_loop_nest(fh, index));
|
|
TRY(rs_push(fh, limit));
|
|
goto instr;
|
|
|
|
case FH_INSTR_DO_QUESTION:
|
|
LOG("\x1b[35mExec: ?do\x1b[m");
|
|
if (instr->data == MAGICADDR_UNRESOLVED) {
|
|
LOGE("Encountered unresolved jump!");
|
|
goto end;
|
|
}
|
|
|
|
TRY(ds_pop(fh, &index));
|
|
TRY(ds_pop(fh, &limit));
|
|
if (index == limit) {
|
|
// jump to end
|
|
fh->execptr = instr->data;
|
|
} else {
|
|
TRY(fh_loop_nest(fh, index));
|
|
TRY(rs_push(fh, limit));
|
|
}
|
|
goto instr;
|
|
|
|
case FH_INSTR_LOOP_PLUS:
|
|
TRY(ds_pop(fh, &val));
|
|
// fall-through
|
|
case FH_INSTR_LOOP:
|
|
if (instr->kind == FH_INSTR_LOOP) {
|
|
val = 1;
|
|
}
|
|
|
|
// R: index,limit
|
|
TRY(rs_peek(fh, &limit));
|
|
|
|
LOG("\x1b[35mExec: +LOOP\x1b[m, i=%d, step %d, limit %d", fh->loop_i, val, limit);
|
|
|
|
const int32_t vi = (int32_t) val;
|
|
const int32_t bdr = (int32_t) limit - (int32_t) 1;
|
|
const int32_t i0 = (int32_t) fh->loop_i;
|
|
fh->loop_i += val; // this can overflow
|
|
const int32_t i1 = (int32_t) fh->loop_i;
|
|
|
|
// TODO this can probably be optimized
|
|
if (
|
|
(vi > 0 && i0 <= bdr && i1 > bdr)
|
|
|| (vi > 0 && i0 > 0 && i1 < 0 && (bdr >= i0 || bdr <= i1))
|
|
|| (vi < 0 && i0 > bdr && i1 <= bdr)
|
|
|| (vi < 0 && i0 < 0 && i1 > 0 && (bdr <= i0 || bdr >= i1))
|
|
) {
|
|
//LOGE("end of loop");
|
|
// end of loop
|
|
TRY(rs_pop(fh, &limit));
|
|
TRY(fh_loop_unnest(fh));
|
|
} else {
|
|
//LOGE("continue loop");
|
|
// continue the loop
|
|
fh->execptr = instr->data;
|
|
}
|
|
goto instr;
|
|
|
|
case FH_INSTR_LEAVE:
|
|
LOG("\x1b[35mExec: leave\x1b[m");
|
|
if (instr->data == MAGICADDR_UNRESOLVED) {
|
|
LOGE("Encountered unresolved jump!");
|
|
goto end;
|
|
}
|
|
TRY(rs_pop(fh, &limit));
|
|
TRY(fh_loop_unnest(fh));
|
|
fh->execptr = instr->data;
|
|
goto instr;
|
|
|
|
case FH_INSTR_OF:
|
|
LOG("\x1b[35mExec: OF\x1b[m");
|
|
if (instr->data == MAGICADDR_UNRESOLVED) {
|
|
LOGE("Encountered unresolved OF!");
|
|
goto end;
|
|
}
|
|
TRY(ds_pop(fh, &testval));
|
|
TRY(ds_pop(fh, &val));
|
|
|
|
LOG("Val %d, testval %d", val, testval);
|
|
|
|
if (testval != val) {
|
|
LOG("No match, go to ENDOF");
|
|
TRY(ds_push(fh, val));
|
|
fh->execptr = instr->data;
|
|
}
|
|
goto instr;
|
|
|
|
case FH_INSTR_ENDCASE:
|
|
LOG("\x1b[35mExec: ENDCASE\x1b[m");
|
|
TRY(ds_pop(fh, &val)); // discard the tested value
|
|
goto instr;
|
|
|
|
case FH_INSTR_ALLOCSTR:
|
|
strl = instr->data;
|
|
LOG("\x1b[35mExec: alloc-str\x1b[m \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
|
|
TRY(ds_push(fh, fh->execptr)); // give pointer directly into the definition
|
|
TRY(ds_push(fh, strl));
|
|
fh->execptr += strl;
|
|
goto instr;
|
|
|
|
case FH_INSTR_ALLOCSTR_C:
|
|
LOG("\x1b[35mExec: alloc-str-c\x1b[m \"%.*s\", %d", fh->heap[fh->execptr], fh_str_at(fh, fh->execptr + 1), fh->heap[fh->execptr]);
|
|
TRY(ds_push(fh, fh->execptr));
|
|
fh->execptr += instr->data;
|
|
goto instr;
|
|
|
|
case FH_INSTR_TYPESTR:
|
|
strl = instr->data;
|
|
LOG("\x1b[35mExec: type-str\x1b[m \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
|
|
FHPRINT("%.*s", (int) strl, fh_str_at(fh, fh->execptr));
|
|
fh->execptr += strl;
|
|
goto instr;
|
|
|
|
case FH_INSTR_ABORTSTR:
|
|
strl = instr->data;
|
|
TRY(ds_pop(fh, &val));
|
|
LOG("\x1b[35mExec: abort-str\x1b[m \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
|
|
if (val != 0) {
|
|
FHPRINT("%.*s", (int) strl, fh_str_at(fh, fh->execptr));
|
|
LOG("ABORTing");
|
|
fh_abort(fh);
|
|
goto end;
|
|
}
|
|
fh->execptr += strl;
|
|
goto instr;
|
|
|
|
case FH_INSTR_ENDWORD:
|
|
LOG("\x1b[35mExec: word-end\x1b[m");
|
|
TRY(rs_pop(fh, &fh->execptr));
|
|
if (fh->execptr == MAGICADDR_EXEC_INTERACTIVE) {
|
|
LOG("Done running compiled word");
|
|
goto end;
|
|
}
|
|
goto instr;
|
|
|
|
case FH_INSTR_ACTIONOF:
|
|
LOG("\x1b[35mExec: actionof\x1b[m");
|
|
w2 = fh_word_at(fh, instr->data);
|
|
TRY(ds_push(fh, w2->param));
|
|
goto instr;
|
|
|
|
case FH_INSTR_ISDEFER:
|
|
LOG("\x1b[35mExec: isdefer\x1b[m");
|
|
w2 = fh_word_at(fh, instr->data);
|
|
TRY(ds_pop(fh, &w2->param));
|
|
goto instr;
|
|
|
|
default:
|
|
LOGE("Run handler not implemented for instr opcode %d", instr->kind);
|
|
return FH_ERR_BAD_OPCODE;
|
|
}
|
|
|
|
end:
|
|
fh->executing_compiled = 0;
|
|
return FH_OK;
|
|
}
|
|
|
|
|
|
/** Initialize a runtime */
|
|
enum fh_error fh_init(struct fh_thread_s *fh)
|
|
{
|
|
enum fh_error rv;
|
|
|
|
/* Make sure we have a clean state */
|
|
memset(fh, 0, sizeof(struct fh_thread_s));
|
|
|
|
fh->dict_last = MAGICADDR_DICTFIRST;
|
|
TRY(register_builtin_words(fh));
|
|
|
|
fh->execptr = MAGICADDR_EXEC_INTERACTIVE;
|
|
fh->base = 10;
|
|
return FH_OK;
|
|
}
|
|
|
|
enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr)
|
|
{
|
|
enum fh_error rv;
|
|
struct fh_word_s *w = fh_word_at(fh, addr);
|
|
if (!w) { return FH_ERR_INTERNAL; }
|
|
if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) {
|
|
LOG("\x1b[34m[%s] Compile word:\x1b[m %s", stateshort[fh->state], w->name);
|
|
TRY(fh_put_instr(fh, FH_INSTR_WORD, addr));
|
|
} else {
|
|
/* interpret or immediate in compiled code */
|
|
// 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));
|
|
// if (fh->state == FH_STATE_INTERPRET && fh->substate == FH_SUBSTATE_NONE) {
|
|
// fh_setstate(fh, oldstate, 0);
|
|
// }
|
|
}
|
|
return FH_OK;
|
|
}
|
|
|
|
enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t wordlen, uint32_t *addr_out)
|
|
{
|
|
if (name == NULL) {
|
|
return FH_ERR_UNKNOWN_WORD;
|
|
}
|
|
if (wordlen == 0) {
|
|
wordlen = strlen(name);
|
|
}
|
|
uint32_t addr = fh->dict_last;
|
|
while (addr != MAGICADDR_DICTFIRST) {
|
|
struct fh_word_s *w = fh_word_at(fh, addr);
|
|
if (!w) {
|
|
break;
|
|
}
|
|
if (EQ(name, w->name, wordlen) && 0 == (w->flags & WORDFLAG_HIDDEN)) { // skip hidden names
|
|
if (addr_out) {
|
|
*addr_out = addr;
|
|
}
|
|
return FH_OK;
|
|
}
|
|
addr = w->previous;
|
|
}
|
|
// no log message, this can be OK - e.g. parsing a number
|
|
//LOG("fail to find word %.*s", wordlen, name);
|
|
return FH_ERR_UNKNOWN_WORD;
|
|
}
|
|
|
|
enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue)
|
|
{
|
|
enum fh_error rv;
|
|
LOG("Loop nest");
|
|
TRY(rs_push(fh, fh->loop_j));
|
|
fh->loop_j = fh->loop_i;
|
|
fh->loop_i = indexvalue;
|
|
return FH_OK;
|
|
}
|
|
|
|
enum fh_error fh_loop_unnest(struct fh_thread_s *fh)
|
|
{
|
|
enum fh_error rv;
|
|
LOG("Loop un-nest");
|
|
fh->loop_i = fh->loop_j;
|
|
TRY(rs_pop(fh, &fh->loop_j));
|
|
return FH_OK;
|
|
}
|
|
|
|
|
|
/** Postpone a word */
|
|
enum fh_error fh_postpone_word(
|
|
struct fh_thread_s *fh,
|
|
const char *name,
|
|
const size_t wordlen
|
|
)
|
|
{
|
|
enum fh_error rv;
|
|
uint32_t wadr;
|
|
TRY(fh_find_word(fh, name, wordlen, &wadr));
|
|
|
|
LOG("Postpone word");
|
|
TRY(fh_put_instr(fh, FH_INSTR_POSTPONED_WORD, wadr));
|
|
|
|
return FH_OK;
|
|
}
|
|
|