|
|
|
#include <stdio.h>
|
|
|
|
#include <stdint.h>
|
|
|
|
#include <stdbool.h>
|
|
|
|
#include <stdlib.h>
|
|
|
|
#include <string.h>
|
|
|
|
#include <errno.h>
|
|
|
|
|
|
|
|
#define CONTROL_STACK_DEPTH 1024
|
|
|
|
#define DATA_STACK_DEPTH 1024
|
|
|
|
#define RETURN_STACK_DEPTH 1024
|
|
|
|
#define MAX_NAME_LEN 64
|
|
|
|
#define DICT_SIZE 1024
|
|
|
|
#define COMPILED_BUFFER_SIZE (1024*1024)
|
|
|
|
#define HEAP_SIZE (1024*1024)
|
|
|
|
#define MAXLINE 65535
|
|
|
|
|
|
|
|
struct fh_thread_s;
|
|
|
|
struct fh_word_s;
|
|
|
|
struct fh_instruction_s;
|
|
|
|
|
|
|
|
/* if the return address is this, we should drop back to interactive mode */
|
|
|
|
#define MAGICADDR_INTERACTIVE 0xFFFFFFFFULL
|
|
|
|
|
|
|
|
#define ALIGNWORD(var) \
|
|
|
|
do { \
|
|
|
|
while (((var) % 4) != 0) { (var)++; } \
|
|
|
|
} while (0)
|
|
|
|
|
|
|
|
/* logging, TODO make levels configurable */
|
|
|
|
#define LOG(format, ...) fprintf(stderr, format "\r\n", ##__VA_ARGS__)
|
|
|
|
#define LOGI(format, ...) fprintf(stderr, "\x1b[32m" format "\x1b[m\r\n", ##__VA_ARGS__)
|
|
|
|
#define LOGE(format, ...) fprintf(stderr, "\x1b[31;1m" format "\x1b[m\r\n", ##__VA_ARGS__)
|
|
|
|
/* Forth standard output. XXX should be stdout, but then colors get mangled */
|
|
|
|
#define FHPRINT(format, ...) fprintf(stderr, "\x1b[33;1m" format "\x1b[m", ##__VA_ARGS__)
|
|
|
|
|
|
|
|
enum fh_error {
|
|
|
|
FH_OK = 0,
|
|
|
|
FH_ERR_CS_OVERFLOW,
|
|
|
|
FH_ERR_DS_OVERFLOW,
|
|
|
|
FH_ERR_RS_OVERFLOW,
|
|
|
|
FH_ERR_CS_UNDERFLOW,
|
|
|
|
FH_ERR_DS_UNDERFLOW,
|
|
|
|
FH_ERR_RS_UNDERFLOW,
|
|
|
|
FH_ERR_HEAP_FULL,
|
|
|
|
FH_ERR_DICT_FULL,
|
|
|
|
FH_ERR_COMPILE_FULL,
|
|
|
|
FH_ERR_NAME_TOO_LONG,
|
|
|
|
FH_ERR_INVALID_STATE,
|
|
|
|
FH_ERR_INTERNAL,
|
|
|
|
FH_ERR_UNKNOWN_WORD,
|
|
|
|
FH_ERR_MAX,
|
|
|
|
};
|
|
|
|
|
|
|
|
static const char *errornames[] = {
|
|
|
|
[FH_OK] = "OK",
|
|
|
|
[FH_ERR_CS_OVERFLOW] = "CS_OVERFLOW",
|
|
|
|
[FH_ERR_DS_OVERFLOW] = "DS_OVERFLOW",
|
|
|
|
[FH_ERR_RS_OVERFLOW] = "RS_OVERFLOW",
|
|
|
|
[FH_ERR_CS_UNDERFLOW] = "CS_UNDERFLOW",
|
|
|
|
[FH_ERR_DS_UNDERFLOW] = "DS_UNDERFLOW",
|
|
|
|
[FH_ERR_RS_UNDERFLOW] = "RS_UNDERFLOW",
|
|
|
|
[FH_ERR_HEAP_FULL] = "HEAP_FULL",
|
|
|
|
[FH_ERR_DICT_FULL] = "DICT_FULL",
|
|
|
|
[FH_ERR_COMPILE_FULL] = "COMPILE_FULL",
|
|
|
|
[FH_ERR_NAME_TOO_LONG] = "NAME_TOO_LONG",
|
|
|
|
[FH_ERR_INVALID_STATE] = "INVALID_STATE",
|
|
|
|
[FH_ERR_INTERNAL] = "INTERNAL",
|
|
|
|
[FH_ERR_UNKNOWN_WORD] = "UNKNOWN_WORD",
|
|
|
|
};
|
|
|
|
|
|
|
|
const char *fherr_name(enum fh_error e)
|
|
|
|
{
|
|
|
|
if (e >= FH_ERR_MAX) {
|
|
|
|
return "Unknown";
|
|
|
|
}
|
|
|
|
return errornames[e];
|
|
|
|
}
|
|
|
|
|
|
|
|
typedef enum fh_error (*word_exec_t)(struct fh_thread_s *fh);
|
|
|
|
|
|
|
|
struct fh_word_s {
|
|
|
|
char name[MAX_NAME_LEN];
|
|
|
|
word_exec_t handler;
|
|
|
|
bool builtin;
|
|
|
|
bool immediate;
|
|
|
|
uint32_t start;
|
|
|
|
uint32_t end;
|
|
|
|
};
|
|
|
|
|
|
|
|
enum fb_instruction_kind {
|
|
|
|
/* Data is a word number in the dict */
|
|
|
|
FH_INSTR_WORD,
|
|
|
|
|
|
|
|
/* Data is a numeric value to push on the data stack */
|
|
|
|
FH_INSTR_NUMBER,
|
|
|
|
};
|
|
|
|
|
|
|
|
struct fh_instruction_s {
|
|
|
|
enum fb_instruction_kind kind;
|
|
|
|
uint32_t data;
|
|
|
|
};
|
|
|
|
|
|
|
|
/** words that are not in the dict, have special effect */
|
|
|
|
enum compiler_word {
|
|
|
|
CPLWORD_ENDWORD = DICT_SIZE + 1,
|
|
|
|
CPLWORD_ALLOCSTR,
|
|
|
|
CPLWORD_TYPESTR,
|
|
|
|
};
|
|
|
|
|
|
|
|
_Static_assert(sizeof(struct fh_instruction_s) % 4 == 0, "Instruction struct is aligned");
|
|
|
|
|
|
|
|
enum fh_state {
|
|
|
|
FH_STATE_INTERPRET = 0,
|
|
|
|
FH_STATE_COMPILE,
|
|
|
|
FH_STATE_SHUTDOWN,
|
|
|
|
FH_STATE_MAX,
|
|
|
|
};
|
|
|
|
|
|
|
|
static const char *statenames[] = {
|
|
|
|
[FH_STATE_INTERPRET] = "INTERPRET",
|
|
|
|
[FH_STATE_COMPILE] = "COMPILE",
|
|
|
|
[FH_STATE_SHUTDOWN] = "SHUTDOWN",
|
|
|
|
};
|
|
|
|
|
|
|
|
enum fh_substate {
|
|
|
|
FH_SUBSTATE_NONE = 0,
|
|
|
|
FH_SUBSTATE_COLONNAME,
|
|
|
|
FH_SUBSTATE_SQUOTE,
|
|
|
|
FH_SUBSTATE_DOTQUOTE,
|
|
|
|
FH_SUBSTATE_PARENCOMMENT,
|
|
|
|
FH_SUBSTATE_LINECOMMENT,
|
|
|
|
FH_SUBSTATE_MAX,
|
|
|
|
};
|
|
|
|
|
|
|
|
static const char *substatenames[] = {
|
|
|
|
[FH_SUBSTATE_NONE] = "NONE",
|
|
|
|
[FH_SUBSTATE_COLONNAME] = "COLONNAME",
|
|
|
|
[FH_SUBSTATE_SQUOTE] = "SQUOTE",
|
|
|
|
[FH_SUBSTATE_DOTQUOTE] = "DOTQUOTE",
|
|
|
|
[FH_SUBSTATE_PARENCOMMENT] = "PARENCOMMENT",
|
|
|
|
[FH_SUBSTATE_LINECOMMENT] = "LINECOMMENT",
|
|
|
|
};
|
|
|
|
|
|
|
|
struct fh_thread_s {
|
|
|
|
/** Control stack */
|
|
|
|
uint32_t control_stack[CONTROL_STACK_DEPTH];
|
|
|
|
size_t control_stack_top;
|
|
|
|
|
|
|
|
/** Data stack */
|
|
|
|
uint32_t data_stack[DATA_STACK_DEPTH];
|
|
|
|
size_t data_stack_top;
|
|
|
|
|
|
|
|
/** Return stack */
|
|
|
|
uint32_t return_stack[RETURN_STACK_DEPTH];
|
|
|
|
size_t return_stack_top;
|
|
|
|
|
|
|
|
/** Data heap */
|
|
|
|
uint8_t heap[HEAP_SIZE];
|
|
|
|
size_t heap_top;
|
|
|
|
|
|
|
|
/** Compile buffer, used for both word data and literals */
|
|
|
|
uint8_t compile[COMPILED_BUFFER_SIZE];
|
|
|
|
size_t compile_top;
|
|
|
|
/** Pointer into the compile buffer for execution */
|
|
|
|
uint32_t execptr;
|
|
|
|
|
|
|
|
/** Word dict */
|
|
|
|
struct fh_word_s dict[DICT_SIZE];
|
|
|
|
uint32_t dict_top;
|
|
|
|
|
|
|
|
/** Forth state */
|
|
|
|
enum fh_state state;
|
|
|
|
/** Forth sub-state */
|
|
|
|
enum fh_substate substate;
|
|
|
|
/** Word currently being executed - a pointer is placed here
|
|
|
|
* before calling the handler */
|
|
|
|
struct fh_word_s *exec_word;
|
|
|
|
};
|
|
|
|
|
|
|
|
#define TRY(x) \
|
|
|
|
do { \
|
|
|
|
if (FH_OK != (rv = (x))) return rv; \
|
|
|
|
} while (0)
|
|
|
|
|
|
|
|
#define TRY_FAIL(x) \
|
|
|
|
do { \
|
|
|
|
if (FH_OK != (rv = (x))) goto fail; \
|
|
|
|
} while (0)
|
|
|
|
|
|
|
|
/** 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;
|
|
|
|
}
|
|
|
|
|
|
|
|
//region Push & Pop
|
|
|
|
|
|
|
|
static inline enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out)
|
|
|
|
{
|
|
|
|
if (fh->data_stack_top == 0) {
|
|
|
|
LOG("DS pop UNDERFLOW");
|
|
|
|
return FH_ERR_DS_UNDERFLOW;
|
|
|
|
}
|
|
|
|
*out = fh->data_stack[--fh->data_stack_top];
|
|
|
|
LOG("DS pop %d", *out);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
static inline enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out)
|
|
|
|
{
|
|
|
|
if (fh->return_stack_top == 0) {
|
|
|
|
LOG("RS pop UNDERFLOW");
|
|
|
|
return FH_ERR_RS_UNDERFLOW;
|
|
|
|
}
|
|
|
|
*out = fh->return_stack[--fh->return_stack_top];
|
|
|
|
LOG("RS pop %d", *out);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
static inline enum fh_error cs_pop(struct fh_thread_s *fh, uint32_t *out)
|
|
|
|
{
|
|
|
|
if (fh->control_stack_top == 0) {
|
|
|
|
LOG("CS pop UNDERFLOW");
|
|
|
|
return FH_ERR_CS_UNDERFLOW;
|
|
|
|
}
|
|
|
|
*out = fh->control_stack[--fh->control_stack_top];
|
|
|
|
LOG("CS pop %d", *out);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
static inline enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in)
|
|
|
|
{
|
|
|
|
LOG("DS push %d", in);
|
|
|
|
if (fh->data_stack_top == DATA_STACK_DEPTH) {
|
|
|
|
return FH_ERR_DS_OVERFLOW;
|
|
|
|
}
|
|
|
|
fh->data_stack[fh->data_stack_top++] = in;
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
static inline enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in)
|
|
|
|
{
|
|
|
|
LOG("RS push %d", in);
|
|
|
|
if (fh->return_stack_top == RETURN_STACK_DEPTH) {
|
|
|
|
return FH_ERR_RS_OVERFLOW;
|
|
|
|
}
|
|
|
|
fh->return_stack[fh->return_stack_top++] = in;
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
static inline enum fh_error cs_push(struct fh_thread_s *fh, uint32_t in)
|
|
|
|
{
|
|
|
|
LOG("CS push %d", in);
|
|
|
|
if (fh->control_stack_top == CONTROL_STACK_DEPTH) {
|
|
|
|
return FH_ERR_CS_OVERFLOW;
|
|
|
|
}
|
|
|
|
fh->control_stack[fh->control_stack_top++] = in;
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
//endregion Push & Pop
|
|
|
|
|
|
|
|
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]);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void fh_setstate(struct fh_thread_s *fh, enum fh_state state, enum fh_substate substate)
|
|
|
|
{
|
|
|
|
fh->state = state;
|
|
|
|
fh->substate = substate;
|
|
|
|
showstate(fh);
|
|
|
|
}
|
|
|
|
|
|
|
|
void fh_setsubstate(struct fh_thread_s *fh, enum fh_substate substate)
|
|
|
|
{
|
|
|
|
fh->substate = substate;
|
|
|
|
showstate(fh);
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error fh_allot(
|
|
|
|
struct fh_thread_s *fh,
|
|
|
|
size_t len,
|
|
|
|
uint32_t *addr
|
|
|
|
)
|
|
|
|
{
|
|
|
|
uint32_t p = fh->heap_top;
|
|
|
|
ALIGNWORD(p);
|
|
|
|
|
|
|
|
if (p + len > HEAP_SIZE) {
|
|
|
|
return FH_ERR_HEAP_FULL;
|
|
|
|
}
|
|
|
|
|
|
|
|
*addr = p;
|
|
|
|
|
|
|
|
size_t next = p + len;
|
|
|
|
ALIGNWORD(next);
|
|
|
|
fh->heap_top = next;
|
|
|
|
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error fh_compile_reserve(
|
|
|
|
struct fh_thread_s *fh,
|
|
|
|
size_t len,
|
|
|
|
uint32_t *addr
|
|
|
|
)
|
|
|
|
{
|
|
|
|
uint32_t p = fh->compile_top;
|
|
|
|
// align up
|
|
|
|
ALIGNWORD(p);
|
|
|
|
|
|
|
|
if (p + len > COMPILED_BUFFER_SIZE) {
|
|
|
|
return FH_ERR_HEAP_FULL;
|
|
|
|
}
|
|
|
|
|
|
|
|
*addr = p;
|
|
|
|
|
|
|
|
size_t next = p + len;
|
|
|
|
ALIGNWORD(next);
|
|
|
|
fh->compile_top = next;
|
|
|
|
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
//region Builtin Words
|
|
|
|
|
|
|
|
enum fh_error w_add(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
uint32_t a = 0, b = 0;
|
|
|
|
TRY(ds_pop(fh, &a));
|
|
|
|
TRY(ds_pop(fh, &b));
|
|
|
|
TRY(ds_push(fh, a + b));
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_sub(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
uint32_t a = 0, b = 0;
|
|
|
|
TRY(ds_pop(fh, &a));
|
|
|
|
TRY(ds_pop(fh, &b));
|
|
|
|
TRY(ds_push(fh, a - b));
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_mul(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
uint32_t a = 0, b = 0;
|
|
|
|
TRY(ds_pop(fh, &a));
|
|
|
|
TRY(ds_pop(fh, &b));
|
|
|
|
TRY(ds_push(fh, a * b));
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_user_word(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
const struct fh_word_s *w;
|
|
|
|
const struct fh_word_s *w2;
|
|
|
|
uint32_t wn;
|
|
|
|
|
|
|
|
call:
|
|
|
|
w = fh->exec_word;
|
|
|
|
if (!w) { return FH_ERR_INTERNAL; }
|
|
|
|
|
|
|
|
LOG("Run user word: %s", w->name);
|
|
|
|
|
|
|
|
TRY(rs_push(fh, fh->execptr));
|
|
|
|
fh->execptr = w->start;
|
|
|
|
|
|
|
|
instr:;
|
|
|
|
// make sure it's aligned
|
|
|
|
ALIGNWORD(fh->execptr);
|
|
|
|
const struct fh_instruction_s *instr = (const struct fh_instruction_s *) &fh->compile[fh->execptr];
|
|
|
|
fh->execptr += sizeof(struct fh_instruction_s);
|
|
|
|
|
|
|
|
uint32_t strl;
|
|
|
|
uint32_t addr = 0;
|
|
|
|
switch (instr->kind) {
|
|
|
|
case FH_INSTR_NUMBER:
|
|
|
|
TRY(ds_push(fh, instr->data));
|
|
|
|
goto instr;
|
|
|
|
|
|
|
|
case FH_INSTR_WORD:
|
|
|
|
wn = instr->data;
|
|
|
|
switch (wn) {
|
|
|
|
case CPLWORD_ALLOCSTR:
|
|
|
|
case CPLWORD_TYPESTR:
|
|
|
|
strl = *((uint32_t *) &fh->compile[fh->execptr]);
|
|
|
|
fh->execptr += 4;
|
|
|
|
if (wn == CPLWORD_ALLOCSTR) {
|
|
|
|
TRY(fh_allot(fh, strl, &addr));
|
|
|
|
memcpy(&fh->heap[addr], &fh->compile[fh->execptr], strl);
|
|
|
|
LOG("Exec: alloc-str \"%.*s\"", strl, &fh->heap[addr]);
|
|
|
|
TRY(ds_push(fh, addr));
|
|
|
|
TRY(ds_push(fh, strl));
|
|
|
|
fh->execptr += strl;
|
|
|
|
} else {
|
|
|
|
FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]);
|
|
|
|
LOG("Exec: type-str \"%.*s\"", strl, &fh->heap[addr]);
|
|
|
|
}
|
|
|
|
goto instr;
|
|
|
|
|
|
|
|
case CPLWORD_ENDWORD:
|
|
|
|
LOG("Exec: word-end (RETURN)");
|
|
|
|
TRY(rs_pop(fh, &fh->execptr));
|
|
|
|
if (fh->execptr == MAGICADDR_INTERACTIVE) {
|
|
|
|
goto end;
|
|
|
|
}
|
|
|
|
goto instr;
|
|
|
|
|
|
|
|
default:
|
|
|
|
w2 = &fh->dict[instr->data];
|
|
|
|
if (w2->builtin) {
|
|
|
|
LOG("Exec: builtin-word %s", w2->name);
|
|
|
|
w2->handler(fh);
|
|
|
|
goto instr;
|
|
|
|
} else {
|
|
|
|
LOG("Exec: user-word %s (CALL)", w2->name);
|
|
|
|
fh->exec_word = &fh->dict[instr->data];
|
|
|
|
goto call;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
end:
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_colon(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
if (fh->state != FH_STATE_INTERPRET) {
|
|
|
|
return FH_ERR_INVALID_STATE;
|
|
|
|
}
|
|
|
|
|
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, FH_SUBSTATE_COLONNAME);
|
|
|
|
|
|
|
|
if (fh->dict_top >= DICT_SIZE) {
|
|
|
|
return FH_ERR_DICT_FULL;
|
|
|
|
}
|
|
|
|
fh->dict[fh->dict_top].start = fh->compile_top;
|
|
|
|
fh->dict[fh->dict_top].handler = w_user_word;
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_semicolon(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
uint32_t addr = 0;
|
|
|
|
struct fh_instruction_s instr;
|
|
|
|
|
|
|
|
if (fh->state != FH_STATE_COMPILE) {
|
|
|
|
return FH_ERR_INVALID_STATE;
|
|
|
|
}
|
|
|
|
|
|
|
|
TRY(fh_compile_reserve(fh, sizeof(struct fh_instruction_s), &addr));
|
|
|
|
instr.kind = FH_INSTR_WORD;
|
|
|
|
instr.data = CPLWORD_ENDWORD;
|
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s));
|
|
|
|
|
|
|
|
/* Return to interpret state */
|
|
|
|
fh_setstate(fh, FH_STATE_INTERPRET, 0);
|
|
|
|
fh->dict[fh->dict_top].end = fh->compile_top; /* one past the end cell */
|
|
|
|
fh->dict_top++;
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_dot(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
uint32_t a = 0;
|
|
|
|
TRY(ds_pop(fh, &a));
|
|
|
|
|
|
|
|
FHPRINT("%d ", (int32_t) a);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_type(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
uint32_t count = 0, addr = 0;
|
|
|
|
TRY(ds_pop(fh, &count));
|
|
|
|
TRY(ds_pop(fh, &addr));
|
|
|
|
|
|
|
|
FHPRINT("%.*s", count, &fh->heap[addr]);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_cr(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
FHPRINT("\r\n");
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_space(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
FHPRINT(" ");
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_s_quote(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_SQUOTE);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_dot_quote(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_DOTQUOTE);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_backslash(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_LINECOMMENT);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_paren(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
fh_setsubstate(fh, FH_SUBSTATE_PARENCOMMENT);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error w_bye(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
LOG("state=SHUTDOWN");
|
|
|
|
fh_setstate(fh, FH_STATE_SHUTDOWN, 0);
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error register_builtin_words(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
struct name_and_handler {
|
|
|
|
const char *name;
|
|
|
|
word_exec_t handler;
|
|
|
|
bool immediate;
|
|
|
|
};
|
|
|
|
|
|
|
|
const struct name_and_handler builtins[] = {
|
|
|
|
{"s\"", w_s_quote},
|
|
|
|
{".\"", w_dot_quote},
|
|
|
|
/* Compiler control words */
|
|
|
|
{"bye", w_bye},
|
|
|
|
/* Basic arithmetics */
|
|
|
|
{"+", w_add},
|
|
|
|
{"-", w_sub},
|
|
|
|
{"*", w_mul},
|
|
|
|
/* Control words */
|
|
|
|
{":", w_colon},
|
|
|
|
{";", w_semicolon, 1},
|
|
|
|
{".", w_dot},
|
|
|
|
{"type", w_type},
|
|
|
|
{"cr", w_cr},
|
|
|
|
{"space", w_space},
|
|
|
|
{"\\", w_backslash}, // line comment
|
|
|
|
{"(", w_paren}, // enclosed comment
|
|
|
|
{ /* end marker */ }
|
|
|
|
};
|
|
|
|
|
|
|
|
struct fh_word_s w;
|
|
|
|
const struct name_and_handler *p = builtins;
|
|
|
|
enum fh_error rv;
|
|
|
|
while (p->handler) {
|
|
|
|
strcpy(w.name, p->name);
|
|
|
|
w.handler = p->handler;
|
|
|
|
w.builtin = 1;
|
|
|
|
w.immediate = p->immediate;
|
|
|
|
rv = fh_add_word(&w, fh);
|
|
|
|
if (rv != FH_OK) {
|
|
|
|
return rv;
|
|
|
|
}
|
|
|
|
p++;
|
|
|
|
}
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
#undef ADDWORD
|
|
|
|
|
|
|
|
//endregion Builtin Words
|
|
|
|
|
|
|
|
enum fh_error fh_init_thread(struct fh_thread_s *fh)
|
|
|
|
{
|
|
|
|
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;
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error fh_handle_quoted_string(
|
|
|
|
struct fh_thread_s *fh,
|
|
|
|
char *start,
|
|
|
|
size_t len
|
|
|
|
)
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
uint32_t addr = 0;
|
|
|
|
uint32_t addr2 = 0;
|
|
|
|
struct fh_instruction_s instr;
|
|
|
|
|
|
|
|
if (fh->state == FH_STATE_INTERPRET) {
|
|
|
|
switch (fh->substate) {
|
|
|
|
case FH_SUBSTATE_SQUOTE:
|
|
|
|
TRY(fh_allot(fh, len, &addr));
|
|
|
|
memcpy(&fh->heap[addr], start, len);
|
|
|
|
TRY(ds_push(fh, addr));
|
|
|
|
TRY(ds_push(fh, len));
|
|
|
|
break;
|
|
|
|
case FH_SUBSTATE_DOTQUOTE:
|
|
|
|
FHPRINT("%.*s", (int) len, start);
|
|
|
|
break;
|
|
|
|
|
|
|
|
default:
|
|
|
|
LOGE("Bad substate in interpret mode: %d", fh->substate);
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
/* compile */
|
|
|
|
TRY(fh_compile_reserve(fh, sizeof(struct fh_instruction_s), &addr));
|
|
|
|
TRY(fh_compile_reserve(fh, len + 4, &addr2));
|
|
|
|
instr.kind = FH_INSTR_WORD;
|
|
|
|
instr.data = fh->substate == FH_SUBSTATE_SQUOTE ?
|
|
|
|
CPLWORD_ALLOCSTR :
|
|
|
|
CPLWORD_TYPESTR;
|
|
|
|
uint32_t len32 = len;
|
|
|
|
/* string is encoded as a special compiler command, the size,
|
|
|
|
* and then the string, all 4-byte aligned. */
|
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s));
|
|
|
|
memcpy(&fh->compile[addr2], &len32, 4);
|
|
|
|
memcpy(&fh->compile[addr2 + 4], &start, len);
|
|
|
|
}
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error fh_handle_word(
|
|
|
|
struct fh_thread_s *fh,
|
|
|
|
char *start,
|
|
|
|
size_t len
|
|
|
|
)
|
|
|
|
{
|
|
|
|
if (len >= MAX_NAME_LEN) {
|
|
|
|
return FH_ERR_NAME_TOO_LONG;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* First, try if it's a known word */
|
|
|
|
struct fh_word_s *w = &fh->dict[0];
|
|
|
|
struct fh_instruction_s instr;
|
|
|
|
uint32_t cnt = 0;
|
|
|
|
uint32_t addr = 0;
|
|
|
|
enum fh_error rv;
|
|
|
|
while (w->handler) {
|
|
|
|
if (0 == strncasecmp(start, w->name, len) && w->name[len] == 0) {
|
|
|
|
// word found!
|
|
|
|
if (fh->state == FH_STATE_COMPILE && !w->immediate) {
|
|
|
|
LOG("Compile word call: %s", w->name);
|
|
|
|
TRY(fh_compile_reserve(fh, sizeof(struct fh_instruction_s), &addr));
|
|
|
|
instr.kind = FH_INSTR_WORD;
|
|
|
|
instr.data = cnt;
|
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s));
|
|
|
|
} else {
|
|
|
|
/* interpret */
|
|
|
|
LOG("Interpret word: %s", w->name);
|
|
|
|
fh->exec_word = w;
|
|
|
|
TRY(w->handler(fh));
|
|
|
|
}
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
w++;
|
|
|
|
cnt++;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* word not found, try parsing as number */
|
|
|
|
errno = 0;
|
|
|
|
char *endptr;
|
|
|
|
long v = strtol(start, &endptr, 0);
|
|
|
|
if (errno != 0 || endptr == start) {
|
|
|
|
LOGE("Unknown word and fail to parse as number: %.*s", (int) len, start);
|
|
|
|
return FH_ERR_UNKNOWN_WORD;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (fh->state == FH_STATE_COMPILE) {
|
|
|
|
LOG("Compile number: %d", v);
|
|
|
|
TRY(fh_compile_reserve(fh, sizeof(struct fh_instruction_s), &addr));
|
|
|
|
instr.kind = FH_INSTR_NUMBER;
|
|
|
|
instr.data = (uint32_t) v;
|
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s));
|
|
|
|
} else {
|
|
|
|
/* interpret */
|
|
|
|
LOG("Interpret number: %d", v);
|
|
|
|
TRY(ds_push(fh, (uint32_t) v));
|
|
|
|
}
|
|
|
|
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
static inline bool iswhite(char c)
|
|
|
|
{
|
|
|
|
return c == ' ' || c == '\n' || c == '\t' || c == '\r';
|
|
|
|
}
|
|
|
|
|
|
|
|
static inline bool isnl(char c)
|
|
|
|
{
|
|
|
|
return c == '\n' || c == '\r';
|
|
|
|
}
|
|
|
|
|
|
|
|
enum fh_error fh_process_line(struct fh_thread_s *fh, char *linebuf)
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
char *rp = linebuf;
|
|
|
|
char c;
|
|
|
|
|
|
|
|
LOGI("%s", linebuf);
|
|
|
|
|
|
|
|
while (0 != (c = *rp) && fh->state != FH_STATE_SHUTDOWN) {
|
|
|
|
/* end on newline */
|
|
|
|
if (isnl(c)) {
|
|
|
|
goto done;
|
|
|
|
}
|
|
|
|
/* skip whitespace */
|
|
|
|
if (iswhite(c)) {
|
|
|
|
rp++;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
|
|
|
|
char *end;
|
|
|
|
size_t length;
|
|
|
|
switch (fh->substate) {
|
|
|
|
case FH_SUBSTATE_NONE:
|
|
|
|
case FH_SUBSTATE_COLONNAME:
|
|
|
|
/* try to read a word */
|
|
|
|
end = strchr(rp, ' ');
|
|
|
|
if (end) {
|
|
|
|
length = end - rp; /* exclude the space */
|
|
|
|
} else {
|
|
|
|
length = strlen(rp);
|
|
|
|
}
|
|
|
|
|
|
|
|
if (fh->substate == FH_SUBSTATE_NONE) {
|
|
|
|
/* eval a word */
|
|
|
|
LOG("Handle \"%.*s\"", (int) length, rp);
|
|
|
|
TRY(fh_handle_word(fh, rp, length));
|
|
|
|
} else {
|
|
|
|
/* 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);
|
|
|
|
}
|
|
|
|
|
|
|
|
if (end) {
|
|
|
|
rp = end + 1;
|
|
|
|
} else {
|
|
|
|
goto done;
|
|
|
|
}
|
|
|
|
break;
|
|
|
|
|
|
|
|
case FH_SUBSTATE_SQUOTE:
|
|
|
|
case FH_SUBSTATE_DOTQUOTE:
|
|
|
|
end = strchr(rp, '"');
|
|
|
|
if (end) {
|
|
|
|
length = end - rp - 1;
|
|
|
|
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_PARENCOMMENT:
|
|
|
|
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_LINECOMMENT:
|
|
|
|
LOG("Discard line comment");
|
|
|
|
goto done; // just discard the rest
|
|
|
|
}
|
|
|
|
}
|
|
|
|
done:
|
|
|
|
LOG("Line done.");
|
|
|
|
return FH_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
int main(int argc, char *argv[])
|
|
|
|
{
|
|
|
|
enum fh_error rv;
|
|
|
|
struct fh_thread_s fh;
|
|
|
|
rv = fh_init_thread(&fh);
|
|
|
|
if (rv != FH_OK) {
|
|
|
|
LOGE("Error in forth init: %s", fherr_name(rv));
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
bool interactive = true;
|
|
|
|
FILE *infile = stdin;
|
|
|
|
|
|
|
|
// TODO use getopt?
|
|
|
|
for (int a = 1; a < argc; a++) {
|
|
|
|
if (argv[a][0] == '-') {
|
|
|
|
// opt
|
|
|
|
} else {
|
|
|
|
infile = fopen(argv[a], "r");
|
|
|
|
interactive = false;
|
|
|
|
if (!infile) {
|
|
|
|
LOGE("Error opening infile: %s", argv[a]);
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
/* process input line by line */
|
|
|
|
int linecnt = 0;
|
|
|
|
char linebuf[MAXLINE];
|
|
|
|
while (fh.state != FH_STATE_SHUTDOWN && fgets(linebuf, MAXLINE, infile)) {
|
|
|
|
linecnt++;
|
|
|
|
|
|
|
|
// trim
|
|
|
|
size_t end = strlen(linebuf) - 1;
|
|
|
|
while (iswhite(linebuf[end])) {
|
|
|
|
linebuf[end] = 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (!linebuf[0]) {
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
|
|
|
|
rv = fh_process_line(&fh, linebuf);
|
|
|
|
if (rv == FH_OK) {
|
|
|
|
FHPRINT("ok\r\n");
|
|
|
|
} else {
|
|
|
|
LOGE("ERROR %s on line %d", fherr_name(rv), linecnt);
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
FHPRINT("Bye.\r\n");
|
|
|
|
return 0;
|
|
|
|
}
|