|
|
|
|
@ -5,919 +5,10 @@ |
|
|
|
|
#include <string.h> |
|
|
|
|
#include <errno.h> |
|
|
|
|
#include <unistd.h> |
|
|
|
|
#include <ctype.h> |
|
|
|
|
|
|
|
|
|
#define CONTROL_STACK_DEPTH 1024 |
|
|
|
|
#define DATA_STACK_DEPTH 1024 |
|
|
|
|
#define RETURN_STACK_DEPTH 1024 |
|
|
|
|
#define MAX_NAME_LEN 32 |
|
|
|
|
#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; |
|
|
|
|
|
|
|
|
|
/** Forth runtime global state */ |
|
|
|
|
struct fh_global_s { |
|
|
|
|
/** Verbose logging enabled */ |
|
|
|
|
bool verbose; |
|
|
|
|
/** Interactive mode (i.e. not started with a file argument) */ |
|
|
|
|
bool interactive; |
|
|
|
|
} fh_globals = {}; |
|
|
|
|
|
|
|
|
|
/* if the return address is this, we should drop back to interactive mode */ |
|
|
|
|
#define MAGICADDR_INTERACTIVE 0xFFFFFFFFULL |
|
|
|
|
|
|
|
|
|
/** Get a value rounded up to multiple of word size */ |
|
|
|
|
#define WORDALIGNED(var) (((var) + 3) & ~3) |
|
|
|
|
|
|
|
|
|
_Static_assert(WORDALIGNED(0) == 0, "word align"); |
|
|
|
|
_Static_assert(WORDALIGNED(1) == 4, "word align"); |
|
|
|
|
_Static_assert(WORDALIGNED(2) == 4, "word align"); |
|
|
|
|
_Static_assert(WORDALIGNED(3) == 4, "word align"); |
|
|
|
|
_Static_assert(WORDALIGNED(4) == 4, "word align"); |
|
|
|
|
_Static_assert(WORDALIGNED(5) == 8, "word align"); |
|
|
|
|
_Static_assert(WORDALIGNED(1023) == 1024, "word align"); |
|
|
|
|
_Static_assert(WORDALIGNED(1024) == 1024, "word align"); |
|
|
|
|
|
|
|
|
|
/* logging */ |
|
|
|
|
#define LOG(format, ...) do { if(fh_globals.verbose) { fprintf(stderr, format "\n", ##__VA_ARGS__); } } while (0) |
|
|
|
|
#define LOGI(format, ...) fprintf(stderr, "\x1b[32m" format "\x1b[m\n", ##__VA_ARGS__) |
|
|
|
|
#define LOGE(format, ...) fprintf(stderr, "\x1b[31;1m" format "\x1b[m\n", ##__VA_ARGS__) |
|
|
|
|
/* Forth standard output. XXX should be stdout, but then colors get mangled if logging is used */ |
|
|
|
|
#define FHPRINT(format, ...) fprintf(stderr, "\x1b[33;1m" format "\x1b[m", ##__VA_ARGS__) |
|
|
|
|
#define FHPRINT_SVC(format, ...) fprintf(stderr, "" format "", ##__VA_ARGS__) |
|
|
|
|
|
|
|
|
|
/** Error codes */ |
|
|
|
|
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, |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
/** Error names */ |
|
|
|
|
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", |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
/** Get error name from code, returns Unknown if not defined */ |
|
|
|
|
const char *fherr_name(enum fh_error e) |
|
|
|
|
{ |
|
|
|
|
if (e >= FH_ERR_MAX) { |
|
|
|
|
return "Unknown"; |
|
|
|
|
} |
|
|
|
|
return errornames[e]; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Word handler typedef */ |
|
|
|
|
typedef enum fh_error (*word_exec_t)(struct fh_thread_s *fh); |
|
|
|
|
|
|
|
|
|
/** Word struct as they are stored in the dictionary */ |
|
|
|
|
struct fh_word_s { |
|
|
|
|
/** Word name */ |
|
|
|
|
char name[MAX_NAME_LEN]; |
|
|
|
|
/**
|
|
|
|
|
* Handler function. |
|
|
|
|
* Builtin functions use pre-defined native handlers. |
|
|
|
|
* User words use a shared handler that executes compiled |
|
|
|
|
* bytecode at 'start' address of the compile-memory area. |
|
|
|
|
*/ |
|
|
|
|
word_exec_t handler; |
|
|
|
|
/** Indicates that this is a built-in instruction and not a word call */ |
|
|
|
|
bool builtin; |
|
|
|
|
/** Indicates that this instruction should always be treated as interpreted,
|
|
|
|
|
* in practice this is only used for `;` */ |
|
|
|
|
bool immediate; |
|
|
|
|
/** Start address in case of user words */ |
|
|
|
|
uint32_t start; |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
/** Bytecode instruction type marker */ |
|
|
|
|
enum fb_instruction_kind { |
|
|
|
|
/* Data = word pointer (dict index) */ |
|
|
|
|
FH_INSTR_WORD, |
|
|
|
|
|
|
|
|
|
/* Data = numeric value to push onto the data stack */ |
|
|
|
|
FH_INSTR_NUMBER, |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
/** One instruction in bytecode */ |
|
|
|
|
struct fh_instruction_s { |
|
|
|
|
/** What is the meaning of data? */ |
|
|
|
|
enum fb_instruction_kind kind; |
|
|
|
|
/** Data word */ |
|
|
|
|
uint32_t data; |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
static inline void instr_init(struct fh_instruction_s *instr, enum fb_instruction_kind kind, uint32_t data) |
|
|
|
|
{ |
|
|
|
|
instr->kind = kind; |
|
|
|
|
instr->data = data; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
#define INSTR_SIZE (sizeof(struct fh_instruction_s)) |
|
|
|
|
|
|
|
|
|
/** Bytecode word indices that are not in the dict, have special effect */ |
|
|
|
|
enum compiler_word { |
|
|
|
|
/** End of a user defined word, pop address and jump back */ |
|
|
|
|
CPLWORD_ENDWORD = DICT_SIZE + 1, |
|
|
|
|
/** This is the `s"` instruction, the length (u32) and string data immediately follow */ |
|
|
|
|
CPLWORD_ALLOCSTR, |
|
|
|
|
/** This is the `."` instruction, same format as above. */ |
|
|
|
|
CPLWORD_TYPESTR, |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
_Static_assert(sizeof(struct fh_instruction_s) % 4 == 0, "Instruction struct is aligned"); |
|
|
|
|
|
|
|
|
|
/** Forth runtime major state */ |
|
|
|
|
enum fh_state { |
|
|
|
|
FH_STATE_INTERPRET = 0, |
|
|
|
|
FH_STATE_COMPILE, |
|
|
|
|
FH_STATE_SHUTDOWN, |
|
|
|
|
FH_STATE_MAX, |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
/** State names */ |
|
|
|
|
static const char *statenames[] = { |
|
|
|
|
[FH_STATE_INTERPRET] = "INTERPRET", |
|
|
|
|
[FH_STATE_COMPILE] = "COMPILE", |
|
|
|
|
[FH_STATE_SHUTDOWN] = "SHUTDOWN", |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
/** Forth runtime minor state */ |
|
|
|
|
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, |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
/** Sub-state names */ |
|
|
|
|
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", |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
/**
|
|
|
|
|
* Forth runtime instance - state variables and memory areas. |
|
|
|
|
* |
|
|
|
|
* Some memory areas, such as the dict or heap, could be moved |
|
|
|
|
* to a shared pointer if multi-threading and synchronization is added. |
|
|
|
|
*/ |
|
|
|
|
struct fh_thread_s { |
|
|
|
|
/** Control stack */ |
|
|
|
|
uint32_t control_stack[CONTROL_STACK_DEPTH]; |
|
|
|
|
size_t control_stack_top; |
|
|
|
|
size_t control_stack_hwm; |
|
|
|
|
|
|
|
|
|
/** Data stack */ |
|
|
|
|
uint32_t data_stack[DATA_STACK_DEPTH]; |
|
|
|
|
size_t data_stack_top; |
|
|
|
|
size_t data_stack_hwm; |
|
|
|
|
|
|
|
|
|
/** Return stack */ |
|
|
|
|
uint32_t return_stack[RETURN_STACK_DEPTH]; |
|
|
|
|
size_t return_stack_top; |
|
|
|
|
size_t return_stack_hwm; |
|
|
|
|
|
|
|
|
|
/** 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) |
|
|
|
|
|
|
|
|
|
/** 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; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Pop from data stack */ |
|
|
|
|
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; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Pop from return stack */ |
|
|
|
|
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; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Pop from control stack */ |
|
|
|
|
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; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
#define UPDATE_HWM(hwm, top) \ |
|
|
|
|
do { \
|
|
|
|
|
if((hwm) < (top)) { \
|
|
|
|
|
(hwm) = (top); \
|
|
|
|
|
} \
|
|
|
|
|
} while(0) |
|
|
|
|
|
|
|
|
|
/** Push to data stack */ |
|
|
|
|
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; |
|
|
|
|
UPDATE_HWM(fh->data_stack_hwm, fh->data_stack_top); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Push to return stack */ |
|
|
|
|
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; |
|
|
|
|
UPDATE_HWM(fh->return_stack_hwm, fh->return_stack_top); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Push to control stack */ |
|
|
|
|
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; |
|
|
|
|
UPDATE_HWM(fh->control_stack_hwm, fh->control_stack_top); |
|
|
|
|
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); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Allocate a heap region, e.g. for a string. The address is stored to `addr` */ |
|
|
|
|
enum fh_error fh_heap_reserve( |
|
|
|
|
struct fh_thread_s *fh, |
|
|
|
|
size_t len, |
|
|
|
|
uint32_t *addr |
|
|
|
|
) |
|
|
|
|
{ |
|
|
|
|
uint32_t p = WORDALIGNED(fh->heap_top); // FIXME this shouldn't be needed
|
|
|
|
|
|
|
|
|
|
if (p + len > HEAP_SIZE) { |
|
|
|
|
return FH_ERR_HEAP_FULL; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
*addr = p; |
|
|
|
|
|
|
|
|
|
fh->heap_top = WORDALIGNED(p + len); |
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Write bytes to heap at a given location. The region must have been previously allocated! */ |
|
|
|
|
void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint32_t len) |
|
|
|
|
{ |
|
|
|
|
memcpy(&fh->heap[addr], src, len); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Allocate heap region and write bytes to it */ |
|
|
|
|
enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len) |
|
|
|
|
{ |
|
|
|
|
enum fh_error rv; |
|
|
|
|
uint32_t addr; |
|
|
|
|
TRY(fh_heap_reserve(fh, len, &addr)); |
|
|
|
|
fh_heap_write(fh, addr, src, len); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Copy bytes from compile area to heap. The region must have been previously allocated! */ |
|
|
|
|
void fh_heap_copy_from_compile(struct fh_thread_s *fh, uint32_t addr, uint32_t srcaddr, uint32_t len) |
|
|
|
|
{ |
|
|
|
|
memcpy(&fh->heap[addr], &fh->compile[srcaddr], len); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Reserve space in the compile memory area */ |
|
|
|
|
enum fh_error fh_compile_reserve( |
|
|
|
|
struct fh_thread_s *fh, |
|
|
|
|
size_t len, |
|
|
|
|
uint32_t *addr |
|
|
|
|
) |
|
|
|
|
{ |
|
|
|
|
uint32_t p = WORDALIGNED(fh->compile_top); // FIXME this shouldn't be needed
|
|
|
|
|
|
|
|
|
|
if (p + len > COMPILED_BUFFER_SIZE) { |
|
|
|
|
return FH_ERR_HEAP_FULL; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
*addr = p; |
|
|
|
|
|
|
|
|
|
fh->compile_top = WORDALIGNED(p + len); |
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Write bytes to compile area at a given location. The region must have been previously allocated! */ |
|
|
|
|
void fh_compile_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint32_t len) |
|
|
|
|
{ |
|
|
|
|
memcpy(&fh->compile[addr], src, len); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Allocate compile region and write bytes to it */ |
|
|
|
|
enum fh_error fh_compile_put(struct fh_thread_s *fh, const void *src, uint32_t len) |
|
|
|
|
{ |
|
|
|
|
enum fh_error rv; |
|
|
|
|
uint32_t addr; |
|
|
|
|
TRY(fh_compile_reserve(fh, len, &addr)); |
|
|
|
|
fh_compile_write(fh, addr, src, len); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
fh->execptr = WORDALIGNED(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) { |
|
|
|
|
/* special case for strings stored in compile memory */ |
|
|
|
|
case CPLWORD_ALLOCSTR: |
|
|
|
|
case CPLWORD_TYPESTR: |
|
|
|
|
strl = *((uint32_t *) &fh->compile[fh->execptr]); |
|
|
|
|
LOG("strl %d", strl); |
|
|
|
|
fh->execptr += 4; // advance past the length
|
|
|
|
|
if (wn == CPLWORD_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)); |
|
|
|
|
fh->execptr += strl; |
|
|
|
|
} else { |
|
|
|
|
FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]); |
|
|
|
|
LOG("Exec: type-str \"%.*s\"", strl, &fh->compile[fh->execptr]); |
|
|
|
|
} |
|
|
|
|
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; |
|
|
|
|
struct fh_instruction_s instr; |
|
|
|
|
|
|
|
|
|
if (fh->state != FH_STATE_COMPILE) { |
|
|
|
|
return FH_ERR_INVALID_STATE; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
instr.kind = FH_INSTR_WORD; |
|
|
|
|
instr.data = CPLWORD_ENDWORD; |
|
|
|
|
TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); |
|
|
|
|
|
|
|
|
|
/* Return to interpret state */ |
|
|
|
|
fh_setstate(fh, FH_STATE_INTERPRET, 0); |
|
|
|
|
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) |
|
|
|
|
{ |
|
|
|
|
(void) fh; |
|
|
|
|
FHPRINT("\n"); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
enum fh_error w_space(struct fh_thread_s *fh) |
|
|
|
|
{ |
|
|
|
|
(void) 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; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Add pointers to built-in word handlers to a runtime struct */ |
|
|
|
|
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, 1}, |
|
|
|
|
{".\"", w_dot_quote, 1}, |
|
|
|
|
/* Compiler control words */ |
|
|
|
|
{"bye", w_bye, 0}, |
|
|
|
|
/* Basic arithmetics */ |
|
|
|
|
{"+", w_add, 0}, |
|
|
|
|
{"-", w_sub, 0}, |
|
|
|
|
{"*", w_mul, 0}, |
|
|
|
|
/* Control words */ |
|
|
|
|
{":", w_colon, 0}, |
|
|
|
|
{";", w_semicolon, 1}, |
|
|
|
|
{".", w_dot, 0}, |
|
|
|
|
{"type", w_type, 0}, |
|
|
|
|
{"cr", w_cr, 0}, |
|
|
|
|
{"space", w_space, 0}, |
|
|
|
|
{"\\", w_backslash, 0}, // line comment
|
|
|
|
|
{"(", w_paren, 0}, // enclosed comment
|
|
|
|
|
{ /* end marker */ } |
|
|
|
|
}; |
|
|
|
|
|
|
|
|
|
// foreach
|
|
|
|
|
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 |
|
|
|
|
|
|
|
|
|
/** Initialize a runtime */ |
|
|
|
|
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; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Process a quoted string read from input */ |
|
|
|
|
static 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; |
|
|
|
|
struct fh_instruction_s instr; |
|
|
|
|
|
|
|
|
|
if (fh->state == FH_STATE_INTERPRET) { |
|
|
|
|
switch (fh->substate) { |
|
|
|
|
case FH_SUBSTATE_SQUOTE: |
|
|
|
|
TRY(fh_heap_put(fh, 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: %s", substatenames[fh->substate]); |
|
|
|
|
} |
|
|
|
|
} else { |
|
|
|
|
LOG("Compile a string"); |
|
|
|
|
/* compile */ |
|
|
|
|
if (fh->substate == FH_SUBSTATE_SQUOTE) { |
|
|
|
|
instr_init(&instr, FH_INSTR_WORD, CPLWORD_ALLOCSTR); |
|
|
|
|
} else { |
|
|
|
|
instr_init(&instr, FH_INSTR_WORD, CPLWORD_TYPESTR); |
|
|
|
|
} |
|
|
|
|
uint32_t len32 = len; |
|
|
|
|
/* string is encoded as a special compiler command, the size,
|
|
|
|
|
* and then the string, all 4-byte aligned. */ |
|
|
|
|
TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); |
|
|
|
|
|
|
|
|
|
TRY(fh_compile_reserve(fh, len + 4, &addr)); |
|
|
|
|
fh_compile_write(fh, addr, &len32, 4); |
|
|
|
|
fh_compile_write(fh, addr + 4, start, len); |
|
|
|
|
} |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** Process a word read from input */ |
|
|
|
|
static 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 */ |
|
|
|
|
// TODO we could use binary search if the dict was ordered
|
|
|
|
|
struct fh_word_s *w = &fh->dict[0]; |
|
|
|
|
struct fh_instruction_s instr; |
|
|
|
|
uint32_t cnt = 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); |
|
|
|
|
instr_init(&instr, FH_INSTR_WORD, cnt); |
|
|
|
|
TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); |
|
|
|
|
} 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: %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; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** True if the character is whitespace */ |
|
|
|
|
static inline bool iswhite(char c) |
|
|
|
|
{ |
|
|
|
|
return c == ' ' || c == '\n' || c == '\t' || c == '\r'; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
/** 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 */ |
|
|
|
|
static enum fh_error fh_process_line(struct fh_thread_s *fh, char *linebuf) |
|
|
|
|
{ |
|
|
|
|
enum fh_error rv; |
|
|
|
|
char *rp = linebuf; |
|
|
|
|
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 (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; |
|
|
|
|
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
|
|
|
|
|
|
|
|
|
|
default: |
|
|
|
|
LOGE("Bad substate %s", substatenames[fh->substate]); |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
done: |
|
|
|
|
LOG("Line done."); |
|
|
|
|
return FH_OK; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
#include "forth.h" |
|
|
|
|
#include "fh_runtime.h" |
|
|
|
|
|
|
|
|
|
int main(int argc, char *argv[]) |
|
|
|
|
{ |
|
|
|
|
@ -968,7 +59,7 @@ int main(int argc, char *argv[]) |
|
|
|
|
|
|
|
|
|
// trim
|
|
|
|
|
size_t end = strlen(linebuf) - 1; |
|
|
|
|
while (iswhite(linebuf[end])) { |
|
|
|
|
while (isspace(linebuf[end])) { |
|
|
|
|
linebuf[end] = 0; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
