Trying to build a forth runtime in C
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.
forth/src/fh_runtime.c

554 lines
14 KiB

#include <string.h>
#include <errno.h>
#include <ctype.h>
#include "fh_error.h"
3 years ago
#include "fh_runtime.h"
#include "fh_builtins.h"
#include "fh_stack.h"
#include "fh_mem.h"
#include "fh_globals.h"
#include "fh_print.h"
3 years ago
struct fh_global_s fh_globals = {};
/** State names */
3 years ago
static const char *statenames[FH_STATE_MAX] = {
3 years ago
[FH_STATE_INTERPRET] = "INTERPRET",
[FH_STATE_COMPILE] = "COMPILE",
[FH_STATE_QUIT] = "RUN",
3 years ago
[FH_STATE_SHUTDOWN] = "SHUTDOWN",
};
/** Sub-state names */
3 years ago
static const char *substatenames[FH_SUBSTATE_MAX] = {
3 years ago
[FH_SUBSTATE_NONE] = "NONE",
[FH_SUBSTATE_COLON_NAME] = "COLON_NAME",
[FH_SUBSTATE_S_QUOTE] = "S_QUOTE",
[FH_SUBSTATE_DOT_QUOTE] = "DOT_QUOTE",
[FH_SUBSTATE_PAREN_COMMENT] = "PAREN_COMMENT",
[FH_SUBSTATE_LINE_COMMENT] = "LINE_COMMENT",
3 years ago
[FH_SUBSTATE_EXIT] = "EXIT",
[FH_SUBSTATE_SEE_NAME] = "SEE_NAME",
[FH_SUBSTATE_POSTPONE_NAME] = "POSTPONE_NAME",
3 years ago
};
/** Add a word to the dictionary. */
enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
{
if (fh->dict_top == DICT_SIZE) {
return FH_ERR_DICT_FULL;
}
memcpy(&fh->dict[fh->dict_top++], w, sizeof(struct fh_word_s));
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 */
3 years ago
enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
3 years ago
{
enum fh_error rv;
const struct fh_word_s *w;
const struct fh_word_s *w2;
3 years ago
w = w0;
3 years ago
call:
if (!w) { return FH_ERR_INTERNAL; }
LOG("Run user word: %s", w->name);
TRY(rs_push(fh, fh->execptr));
fh->execptr = w->start;
instr:;
3 years ago
if (fh->state == FH_STATE_QUIT) {
/* abort or quit was called, return to interactive mode */
fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
return FH_OK;
}
3 years ago
// make sure it's aligned
fh->execptr = WORDALIGNED(fh->execptr);
const struct fh_instruction_s *instr = (const struct fh_instruction_s *) &fh->compile[fh->execptr];
3 years ago
fh->execptr += INSTR_SIZE;
3 years ago
uint32_t strl;
uint32_t val;
3 years ago
uint32_t addr = 0;
struct fh_instruction_s instr2;
3 years ago
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->dict[instr->data];
if (w2->immediate) {
LOG("Call immediate postponed word: %s", w2->name);
TRY(w2->handler(fh, w2));
} else {
LOG("Add postponed word: %s", w2->name);
instr_init(&instr2, FH_INSTR_WORD, instr->data);
TRY(fh_compile_put(fh, &instr, INSTR_SIZE));
}
} else {
LOGE("Postpone in interpret mode!");
goto end;
}
goto instr;
3 years ago
case FH_INSTR_WORD:
w2 = &fh->dict[instr->data];
if (w2->builtin) {
LOG("Exec: builtin-word \"%s\"", w2->name);
w2->handler(fh, w2);
if (fh->substate == FH_SUBSTATE_EXIT) {
fh_setsubstate(fh, 0);
LOG("Exec: early return");
3 years ago
TRY(rs_pop(fh, &fh->execptr));
if (fh->execptr == MAGICADDR_INTERACTIVE) {
goto end;
}
}
goto instr;
} else {
LOG("Exec: user-word %s (CALL)", w2->name);
w = &fh->dict[instr->data];
goto call;
}
case FH_INSTR_JUMPZERO:
if (instr->data == MAGICADDR_UNRESOLVED) {
LOGE("Encountered unresolved jump!");
goto end;
}
TRY(ds_pop(fh, &val));
if (0 == val) {
fh->execptr = instr->data;
}
goto instr;
case FH_INSTR_JUMP:
if (instr->data == MAGICADDR_UNRESOLVED) {
LOGE("Encountered unresolved jump!");
goto end;
}
fh->execptr = instr->data;
goto instr;
/* special case for strings stored in compile memory */
case FH_INSTR_ALLOCSTR:
case FH_INSTR_TYPESTR:
strl = instr->data;
if (instr->kind == FH_INSTR_ALLOCSTR) {
TRY(fh_heap_reserve(fh, strl, &addr));
fh_heap_copy_from_compile(fh, addr, fh->execptr, strl);
LOG("Exec: alloc-str \"%.*s\"", strl, &fh->heap[addr]);
TRY(ds_push(fh, addr));
TRY(ds_push(fh, strl));
} else {
LOG("Exec: type-str \"%.*s\"", strl, &fh->compile[fh->execptr]);
FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]);
3 years ago
}
fh->execptr += strl;
goto instr;
case FH_INSTR_ENDWORD:
LOG("Exec: word-end (RETURN)");
TRY(rs_pop(fh, &fh->execptr));
if (fh->execptr == MAGICADDR_INTERACTIVE) {
goto end;
}
goto instr;
3 years ago
}
end:
return FH_OK;
}
/** Initialize a runtime */
enum fh_error fh_init(struct fh_thread_s *fh)
3 years ago
{
enum fh_error rv;
/* Make sure we have a clean state */
memset(fh, 0, sizeof(struct fh_thread_s));
TRY(register_builtin_words(fh));
fh->execptr = MAGICADDR_INTERACTIVE;
3 years ago
fh->base = 10;
3 years ago
return FH_OK;
}
/** Process a quoted string read from input */
static enum fh_error fh_handle_quoted_string(
struct fh_thread_s *fh,
const char *start,
3 years ago
size_t len
)
{
enum fh_error rv;
uint32_t addr = 0;
struct fh_instruction_s instr;
if (fh->state == FH_STATE_INTERPRET) {
switch (fh->substate) {
case FH_SUBSTATE_S_QUOTE:
3 years ago
TRY(fh_heap_put(fh, start, len));
TRY(ds_push(fh, addr));
TRY(ds_push(fh, len));
break;
case FH_SUBSTATE_DOT_QUOTE:
3 years ago
FHPRINT("%.*s", (int) len, start);
break;
default:
LOGE("Bad substate in interpret mode: %s", substatenames[fh->substate]);
}
} else {
LOG("Compile a string");
/* compile */
if (fh->substate == FH_SUBSTATE_S_QUOTE) {
instr_init(&instr, FH_INSTR_ALLOCSTR, len);
3 years ago
} else {
instr_init(&instr, FH_INSTR_TYPESTR, len);
3 years ago
}
TRY(fh_compile_put(fh, &instr, INSTR_SIZE));
TRY(fh_compile_put(fh, start, len));
3 years ago
}
return FH_OK;
}
enum fh_error fh_handle_word(struct fh_thread_s *fh, const struct fh_word_s *w)
{
struct fh_instruction_s instr;
enum fh_error rv;
if (fh->state == FH_STATE_COMPILE && !w->immediate) {
LOG("Compile word call: %s", w->name);
instr_init(&instr, FH_INSTR_WORD, w->index);
TRY(fh_compile_put(fh, &instr, INSTR_SIZE));
} else {
/* interpret or immediate in compiled code */
LOG("Run word: %s", w->name);
TRY(w->handler(fh, w));
}
return FH_OK;
}
static struct fh_word_s *find_word(struct fh_thread_s *fh, const char *name, const size_t wordlen)
{
struct fh_word_s *w = &fh->dict[0];
uint32_t cnt = 0;
while (w->handler) {
if (0 == strncasecmp(name, w->name, wordlen) && w->name[wordlen] == 0) {
return w;
}
w++;
cnt++;
}
return NULL;
}
3 years ago
/** Process a word read from input */
enum fh_error fh_handle_ascii_word(
3 years ago
struct fh_thread_s *fh,
const char *name,
3 years ago
const size_t wordlen
3 years ago
)
{
enum fh_error rv;
3 years ago
if (wordlen >= MAX_NAME_LEN) {
3 years ago
return FH_ERR_NAME_TOO_LONG;
}
/* First, try if it's a known word */
struct fh_word_s *w = find_word(fh, name, wordlen);
if (w) {// word found!
TRY(fh_handle_word(fh, w));
return FH_OK;
3 years ago
}
/* word not found, try parsing as number */
errno = 0;
char *endptr;
3 years ago
int base = (int) fh->base;
// prefix can override BASE - this is a syntax extension
if (name[0] == '0') {
if (name[1] == 'x') {
3 years ago
base = 16;
} else if (name[1] == 'b') {
3 years ago
base = 2;
} else if (name[1] == 'o') {
3 years ago
base = 8;
}
}
long v = strtol(name, &endptr, base); // XXX if base is 0, this will use auto-detection
if (errno != 0 || (endptr - name) != wordlen) {
LOGE("Unknown word and fail to parse as number: %.*s", (int) wordlen, name);
3 years ago
return FH_ERR_UNKNOWN_WORD;
}
struct fh_instruction_s instr;
3 years ago
if (fh->state == FH_STATE_COMPILE) {
LOG("Compile number: %ld", v);
instr_init(&instr, FH_INSTR_NUMBER, (uint32_t) v);
TRY(fh_compile_put(fh, &instr, INSTR_SIZE));
} else {
/* interpret */
LOG("Interpret number: %ld", v);
TRY(ds_push(fh, (uint32_t) v));
}
return FH_OK;
}
static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
{
if (w->handler == w_user_word) {
uint32_t execptr = w->start;
instr:;
// make sure it's aligned
execptr = WORDALIGNED(execptr);
FHPRINT("0x%08x: ", execptr);
const struct fh_instruction_s *instr = (const struct fh_instruction_s *) &fh->compile[execptr];
execptr += INSTR_SIZE;
uint32_t strl;
uint32_t wn;
const struct fh_word_s *w2;
switch (instr->kind) {
case FH_INSTR_NUMBER:
FHPRINT("Number(%d)\n", instr->data);
goto instr;
case FH_INSTR_WORD:
w2 = &fh->dict[instr->data];
if (w2->name[0]) {
FHPRINT("Call(%s)\n", w2->name);
} else {
FHPRINT("Call(0x%08x)\n", instr->data);
}
goto instr;
case FH_INSTR_POSTPONED_WORD:
w2 = &fh->dict[instr->data];
if (w2->name[0]) {
FHPRINT("Postpone(%s)\n", w2->name);
} else {
FHPRINT("Postpone(0x%08x)\n", instr->data);
}
goto instr;
case FH_INSTR_JUMPZERO:
FHPRINT("JumpIfZero(0x%08x)\n", instr->data);
goto instr;
case FH_INSTR_JUMP:
FHPRINT("Jump(0x%08x)\n", instr->data);
goto instr;
/* special case for strings stored in compile memory */
case FH_INSTR_ALLOCSTR:
case FH_INSTR_TYPESTR:
strl = instr->data;
if (instr->kind == FH_INSTR_ALLOCSTR) {
FHPRINT("AllocStr(\"%.*s\")\n", strl, &fh->compile[execptr]);
execptr += strl;
} else {
FHPRINT("PrintStr(\"%.*s\")\n", strl, &fh->compile[execptr]);
execptr += strl;
}
goto instr;
case FH_INSTR_ENDWORD:
FHPRINT("END\n");
return;
}
} else {
FHPRINT("(builtin)");
}
}
/** Decompile a word */
static enum fh_error fh_see_word(
struct fh_thread_s *fh,
const char *name,
const size_t wordlen
)
{
struct fh_word_s *w = find_word(fh, name, wordlen);
if (!w) {
return FH_ERR_UNKNOWN_WORD;
}
show_word(fh, w);
return FH_OK;
}
/** Postpone a word */
static enum fh_error fh_postpone_word(
struct fh_thread_s *fh,
const char *name,
const size_t wordlen
)
{
struct fh_word_s *w = find_word(fh, name, wordlen);
if (!w) {
return FH_ERR_UNKNOWN_WORD;
}
enum fh_error rv;
struct fh_instruction_s instr;
LOG("Postpone %s", w->name);
instr_init(&instr, FH_INSTR_POSTPONED_WORD, w->index);
TRY(fh_compile_put(fh, &instr, INSTR_SIZE));
return FH_OK;
}
3 years ago
/** True if the character is CR or LF */
static inline bool isnl(char c)
{
return c == '\n' || c == '\r';
}
/** Process a line read from input */
enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf)
3 years ago
{
enum fh_error rv;
const char *rp = linebuf;
3 years ago
char c;
if (!fh_globals.interactive) {
LOGI("%s", linebuf);
}
while (0 != (c = *rp) && fh->state != FH_STATE_SHUTDOWN) {
/* end on newline */
if (isnl(c)) {
goto done;
}
/* skip whitespace */
if (isspace(c)) {
rp++;
continue;
}
char *end;
size_t length;
switch (fh->substate) {
case FH_SUBSTATE_NONE:
case FH_SUBSTATE_COLON_NAME:
case FH_SUBSTATE_SEE_NAME:
case FH_SUBSTATE_POSTPONE_NAME:
3 years ago
/* try to read a word */
end = strchr(rp, ' ');
if (end) {
length = end - rp; /* exclude the space */
} else {
length = strlen(rp);
}
switch (fh->substate) {
case FH_SUBSTATE_NONE:
/* eval a word */
LOG("Handle \"%.*s\"", (int) length, rp);
TRY(fh_handle_ascii_word(fh, rp, length));
break;
case FH_SUBSTATE_COLON_NAME:
/* new word's name is found */
LOG("New word name = \"%.*s\"", (int) length, rp);
strncpy(fh->dict[fh->dict_top].name, rp, length);
fh_setsubstate(fh, FH_SUBSTATE_NONE);
break;
case FH_SUBSTATE_SEE_NAME:
TRY(fh_see_word(fh, rp, length));
fh_setsubstate(fh, FH_SUBSTATE_NONE);
break;
case FH_SUBSTATE_POSTPONE_NAME:
TRY(fh_postpone_word(fh, rp, length));
fh_setsubstate(fh, FH_SUBSTATE_NONE);
break;
3 years ago
}
if (end) {
rp = end + 1;
} else {
goto done;
}
break;
case FH_SUBSTATE_S_QUOTE:
case FH_SUBSTATE_DOT_QUOTE:
3 years ago
end = strchr(rp, '"');
if (end) {
length = end - rp;
LOG("Quoted string: \"%.*s\"", (int) length, rp);
TRY(fh_handle_quoted_string(fh, rp, length));
fh_setsubstate(fh, FH_SUBSTATE_NONE);
rp = end + 1;
} else {
/* no end. this is weird. */
LOGE("Unterminated quoted string!");
goto done;
}
break;
case FH_SUBSTATE_PAREN_COMMENT:
3 years ago
end = strchr(rp, ')');
if (end) {
LOG("Discard inline comment");
fh_setsubstate(fh, FH_SUBSTATE_NONE);
rp = end + 1;
} else {
/* no end, discard all */
LOGE("Unterminated parenthesis comment");
goto done;
}
break;
case FH_SUBSTATE_LINE_COMMENT:
3 years ago
LOG("Discard line comment");
goto done; // just discard the rest
default:
LOGE("Bad substate %s", substatenames[fh->substate]);
}
}
done:
LOG("Line done.");
return FH_OK;
}