|
|
@ -3,6 +3,7 @@ |
|
|
|
#include <stdbool.h> |
|
|
|
#include <stdbool.h> |
|
|
|
#include <stdlib.h> |
|
|
|
#include <stdlib.h> |
|
|
|
#include <string.h> |
|
|
|
#include <string.h> |
|
|
|
|
|
|
|
#include <errno.h> |
|
|
|
|
|
|
|
|
|
|
|
#define CONTROL_STACK_DEPTH 1024 |
|
|
|
#define CONTROL_STACK_DEPTH 1024 |
|
|
|
#define DATA_STACK_DEPTH 1024 |
|
|
|
#define DATA_STACK_DEPTH 1024 |
|
|
@ -25,28 +26,62 @@ struct fh_instruction_s; |
|
|
|
while (((var) % 4) != 0) { (var)++; } \
|
|
|
|
while (((var) % 4) != 0) { (var)++; } \
|
|
|
|
} while (0) |
|
|
|
} 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 { |
|
|
|
enum fh_error { |
|
|
|
FH_OK = 0, |
|
|
|
FH_OK = 0, |
|
|
|
FH_ERR_CS_OVERFLOW = -1, |
|
|
|
FH_ERR_CS_OVERFLOW, |
|
|
|
FH_ERR_DS_OVERFLOW = -2, |
|
|
|
FH_ERR_DS_OVERFLOW, |
|
|
|
FH_ERR_RS_OVERFLOW = -3, |
|
|
|
FH_ERR_RS_OVERFLOW, |
|
|
|
FH_ERR_CS_UNDERFLOW = -4, |
|
|
|
FH_ERR_CS_UNDERFLOW, |
|
|
|
FH_ERR_DS_UNDERFLOW = -5, |
|
|
|
FH_ERR_DS_UNDERFLOW, |
|
|
|
FH_ERR_RS_UNDERFLOW = -6, |
|
|
|
FH_ERR_RS_UNDERFLOW, |
|
|
|
FH_ERR_HEAP_FULL = -7, |
|
|
|
FH_ERR_HEAP_FULL, |
|
|
|
FH_ERR_DICT_FULL = -8, |
|
|
|
FH_ERR_DICT_FULL, |
|
|
|
FH_ERR_COMPILE_FULL = -9, |
|
|
|
FH_ERR_COMPILE_FULL, |
|
|
|
FH_ERR_NAME_TOO_LONG = -10, |
|
|
|
FH_ERR_NAME_TOO_LONG, |
|
|
|
FH_ERR_INVALID_STATE = -11, |
|
|
|
FH_ERR_INVALID_STATE, |
|
|
|
FH_ERR_INTERNAL = -12, |
|
|
|
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); |
|
|
|
typedef enum fh_error (*word_exec_t)(struct fh_thread_s *fh); |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s { |
|
|
|
struct fh_word_s { |
|
|
|
char name[MAX_NAME_LEN]; |
|
|
|
char name[MAX_NAME_LEN]; |
|
|
|
word_exec_t handler; |
|
|
|
word_exec_t handler; |
|
|
|
bool builtin; |
|
|
|
bool builtin; |
|
|
|
|
|
|
|
bool immediate; |
|
|
|
uint32_t start; |
|
|
|
uint32_t start; |
|
|
|
uint32_t end; |
|
|
|
uint32_t end; |
|
|
|
}; |
|
|
|
}; |
|
|
@ -122,10 +157,6 @@ struct fh_thread_s { |
|
|
|
/** Word currently being executed - a pointer is placed here
|
|
|
|
/** Word currently being executed - a pointer is placed here
|
|
|
|
* before calling the handler */ |
|
|
|
* before calling the handler */ |
|
|
|
struct fh_word_s *exec_word; |
|
|
|
struct fh_word_s *exec_word; |
|
|
|
|
|
|
|
|
|
|
|
char linebuf[MAXLINE]; |
|
|
|
|
|
|
|
size_t linebuf_len; |
|
|
|
|
|
|
|
size_t linebuf_readptr; |
|
|
|
|
|
|
|
}; |
|
|
|
}; |
|
|
|
|
|
|
|
|
|
|
|
#define TRY(x) \ |
|
|
|
#define TRY(x) \ |
|
|
@ -153,32 +184,39 @@ enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh) |
|
|
|
static inline enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out) |
|
|
|
static inline enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out) |
|
|
|
{ |
|
|
|
{ |
|
|
|
if (fh->data_stack_top == 0) { |
|
|
|
if (fh->data_stack_top == 0) { |
|
|
|
|
|
|
|
LOG("DS pop UNDERFLOW"); |
|
|
|
return FH_ERR_DS_UNDERFLOW; |
|
|
|
return FH_ERR_DS_UNDERFLOW; |
|
|
|
} |
|
|
|
} |
|
|
|
*out = fh->data_stack[--fh->data_stack_top]; |
|
|
|
*out = fh->data_stack[--fh->data_stack_top]; |
|
|
|
|
|
|
|
LOG("DS pop %d", *out); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static inline enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out) |
|
|
|
static inline enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out) |
|
|
|
{ |
|
|
|
{ |
|
|
|
if (fh->return_stack_top == 0) { |
|
|
|
if (fh->return_stack_top == 0) { |
|
|
|
|
|
|
|
LOG("RS pop UNDERFLOW"); |
|
|
|
return FH_ERR_RS_UNDERFLOW; |
|
|
|
return FH_ERR_RS_UNDERFLOW; |
|
|
|
} |
|
|
|
} |
|
|
|
*out = fh->return_stack[--fh->return_stack_top]; |
|
|
|
*out = fh->return_stack[--fh->return_stack_top]; |
|
|
|
|
|
|
|
LOG("RS pop %d", *out); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static inline enum fh_error cs_pop(struct fh_thread_s *fh, uint32_t *out) |
|
|
|
static inline enum fh_error cs_pop(struct fh_thread_s *fh, uint32_t *out) |
|
|
|
{ |
|
|
|
{ |
|
|
|
if (fh->control_stack_top == 0) { |
|
|
|
if (fh->control_stack_top == 0) { |
|
|
|
|
|
|
|
LOG("CS pop UNDERFLOW"); |
|
|
|
return FH_ERR_CS_UNDERFLOW; |
|
|
|
return FH_ERR_CS_UNDERFLOW; |
|
|
|
} |
|
|
|
} |
|
|
|
*out = fh->control_stack[--fh->control_stack_top]; |
|
|
|
*out = fh->control_stack[--fh->control_stack_top]; |
|
|
|
|
|
|
|
LOG("CS pop %d", *out); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static inline enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in) |
|
|
|
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) { |
|
|
|
if (fh->data_stack_top == DATA_STACK_DEPTH) { |
|
|
|
return FH_ERR_DS_OVERFLOW; |
|
|
|
return FH_ERR_DS_OVERFLOW; |
|
|
|
} |
|
|
|
} |
|
|
@ -188,6 +226,7 @@ static inline enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in) |
|
|
|
|
|
|
|
|
|
|
|
static inline enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in) |
|
|
|
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) { |
|
|
|
if (fh->return_stack_top == RETURN_STACK_DEPTH) { |
|
|
|
return FH_ERR_RS_OVERFLOW; |
|
|
|
return FH_ERR_RS_OVERFLOW; |
|
|
|
} |
|
|
|
} |
|
|
@ -197,6 +236,7 @@ static inline enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in) |
|
|
|
|
|
|
|
|
|
|
|
static inline enum fh_error cs_push(struct fh_thread_s *fh, uint32_t in) |
|
|
|
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) { |
|
|
|
if (fh->control_stack_top == CONTROL_STACK_DEPTH) { |
|
|
|
return FH_ERR_CS_OVERFLOW; |
|
|
|
return FH_ERR_CS_OVERFLOW; |
|
|
|
} |
|
|
|
} |
|
|
@ -295,6 +335,9 @@ enum fh_error w_user_word(struct fh_thread_s *fh) |
|
|
|
call: |
|
|
|
call: |
|
|
|
w = fh->exec_word; |
|
|
|
w = fh->exec_word; |
|
|
|
if (!w) { return FH_ERR_INTERNAL; } |
|
|
|
if (!w) { return FH_ERR_INTERNAL; } |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
LOG("Run user word: %s", w->name); |
|
|
|
|
|
|
|
|
|
|
|
TRY(rs_push(fh, fh->execptr)); |
|
|
|
TRY(rs_push(fh, fh->execptr)); |
|
|
|
fh->execptr = w->start; |
|
|
|
fh->execptr = w->start; |
|
|
|
|
|
|
|
|
|
|
@ -321,15 +364,18 @@ enum fh_error w_user_word(struct fh_thread_s *fh) |
|
|
|
if (wn == CPLWORD_ALLOCSTR) { |
|
|
|
if (wn == CPLWORD_ALLOCSTR) { |
|
|
|
TRY(fh_allot(fh, strl, &addr)); |
|
|
|
TRY(fh_allot(fh, strl, &addr)); |
|
|
|
memcpy(&fh->heap[addr], &fh->compile[fh->execptr], strl); |
|
|
|
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, addr)); |
|
|
|
TRY(ds_push(fh, strl)); |
|
|
|
TRY(ds_push(fh, strl)); |
|
|
|
fh->execptr += strl; |
|
|
|
fh->execptr += strl; |
|
|
|
} else { |
|
|
|
} else { |
|
|
|
printf("%.*s", (int) strl, &fh->compile[fh->execptr]); |
|
|
|
FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]); |
|
|
|
|
|
|
|
LOG("Exec: type-str \"%.*s\"", strl, &fh->heap[addr]); |
|
|
|
} |
|
|
|
} |
|
|
|
goto instr; |
|
|
|
goto instr; |
|
|
|
|
|
|
|
|
|
|
|
case CPLWORD_ENDWORD: |
|
|
|
case CPLWORD_ENDWORD: |
|
|
|
|
|
|
|
LOG("Exec: word-end (RETURN)"); |
|
|
|
TRY(rs_pop(fh, &fh->execptr)); |
|
|
|
TRY(rs_pop(fh, &fh->execptr)); |
|
|
|
if (fh->execptr == MAGICADDR_INTERACTIVE) { |
|
|
|
if (fh->execptr == MAGICADDR_INTERACTIVE) { |
|
|
|
goto end; |
|
|
|
goto end; |
|
|
@ -339,9 +385,11 @@ enum fh_error w_user_word(struct fh_thread_s *fh) |
|
|
|
default: |
|
|
|
default: |
|
|
|
w2 = &fh->dict[instr->data]; |
|
|
|
w2 = &fh->dict[instr->data]; |
|
|
|
if (w2->builtin) { |
|
|
|
if (w2->builtin) { |
|
|
|
|
|
|
|
LOG("Exec: builtin-word %s", w2->name); |
|
|
|
w2->handler(fh); |
|
|
|
w2->handler(fh); |
|
|
|
goto instr; |
|
|
|
goto instr; |
|
|
|
} else { |
|
|
|
} else { |
|
|
|
|
|
|
|
LOG("Exec: user-word %s (CALL)", w2->name); |
|
|
|
fh->exec_word = &fh->dict[instr->data]; |
|
|
|
fh->exec_word = &fh->dict[instr->data]; |
|
|
|
goto call; |
|
|
|
goto call; |
|
|
|
} |
|
|
|
} |
|
|
@ -358,6 +406,7 @@ enum fh_error w_colon(struct fh_thread_s *fh) |
|
|
|
return FH_ERR_INVALID_STATE; |
|
|
|
return FH_ERR_INVALID_STATE; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
LOG("state=COMPILE"); |
|
|
|
fh->state = FH_STATE_COMPILE; |
|
|
|
fh->state = FH_STATE_COMPILE; |
|
|
|
fh->substate = FH_SUBSTATE_COLONNAME; |
|
|
|
fh->substate = FH_SUBSTATE_COLONNAME; |
|
|
|
|
|
|
|
|
|
|
@ -385,6 +434,7 @@ enum fh_error w_semicolon(struct fh_thread_s *fh) |
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s)); |
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s)); |
|
|
|
|
|
|
|
|
|
|
|
/* Return to interpret state */ |
|
|
|
/* Return to interpret state */ |
|
|
|
|
|
|
|
LOG("state=INTERPRET"); |
|
|
|
fh->state = FH_STATE_INTERPRET; |
|
|
|
fh->state = FH_STATE_INTERPRET; |
|
|
|
fh->dict[fh->dict_top].end = fh->compile_top; /* one past the end cell */ |
|
|
|
fh->dict[fh->dict_top].end = fh->compile_top; /* one past the end cell */ |
|
|
|
fh->dict_top++; |
|
|
|
fh->dict_top++; |
|
|
@ -397,7 +447,7 @@ enum fh_error w_dot(struct fh_thread_s *fh) |
|
|
|
uint32_t a = 0; |
|
|
|
uint32_t a = 0; |
|
|
|
TRY(ds_pop(fh, &a)); |
|
|
|
TRY(ds_pop(fh, &a)); |
|
|
|
|
|
|
|
|
|
|
|
printf("%d ", (int32_t) a); |
|
|
|
FHPRINT("%d ", (int32_t) a); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -408,19 +458,19 @@ enum fh_error w_type(struct fh_thread_s *fh) |
|
|
|
TRY(ds_pop(fh, &count)); |
|
|
|
TRY(ds_pop(fh, &count)); |
|
|
|
TRY(ds_pop(fh, &addr)); |
|
|
|
TRY(ds_pop(fh, &addr)); |
|
|
|
|
|
|
|
|
|
|
|
printf("%.*s", count, &fh->heap[addr]); |
|
|
|
FHPRINT("%.*s", count, &fh->heap[addr]); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
enum fh_error w_cr(struct fh_thread_s *fh) |
|
|
|
enum fh_error w_cr(struct fh_thread_s *fh) |
|
|
|
{ |
|
|
|
{ |
|
|
|
printf("\r\n"); |
|
|
|
FHPRINT("\r\n"); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
enum fh_error w_space(struct fh_thread_s *fh) |
|
|
|
enum fh_error w_space(struct fh_thread_s *fh) |
|
|
|
{ |
|
|
|
{ |
|
|
|
printf(" "); |
|
|
|
FHPRINT(" "); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -450,6 +500,7 @@ enum fh_error w_paren(struct fh_thread_s *fh) |
|
|
|
|
|
|
|
|
|
|
|
enum fh_error w_bye(struct fh_thread_s *fh) |
|
|
|
enum fh_error w_bye(struct fh_thread_s *fh) |
|
|
|
{ |
|
|
|
{ |
|
|
|
|
|
|
|
LOG("state=SHUTDOWN"); |
|
|
|
fh->state = FH_STATE_SHUTDOWN; |
|
|
|
fh->state = FH_STATE_SHUTDOWN; |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
@ -459,6 +510,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
struct name_and_handler { |
|
|
|
struct name_and_handler { |
|
|
|
const char *name; |
|
|
|
const char *name; |
|
|
|
word_exec_t handler; |
|
|
|
word_exec_t handler; |
|
|
|
|
|
|
|
bool immediate; |
|
|
|
}; |
|
|
|
}; |
|
|
|
|
|
|
|
|
|
|
|
const struct name_and_handler builtins[] = { |
|
|
|
const struct name_and_handler builtins[] = { |
|
|
@ -472,7 +524,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
{"*", w_mul}, |
|
|
|
{"*", w_mul}, |
|
|
|
/* Control words */ |
|
|
|
/* Control words */ |
|
|
|
{":", w_colon}, |
|
|
|
{":", w_colon}, |
|
|
|
{";", w_semicolon}, |
|
|
|
{";", w_semicolon, 1}, |
|
|
|
{".", w_dot}, |
|
|
|
{".", w_dot}, |
|
|
|
{"type", w_type}, |
|
|
|
{"type", w_type}, |
|
|
|
{"cr", w_cr}, |
|
|
|
{"cr", w_cr}, |
|
|
@ -489,6 +541,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) |
|
|
|
strcpy(w.name, p->name); |
|
|
|
strcpy(w.name, p->name); |
|
|
|
w.handler = p->handler; |
|
|
|
w.handler = p->handler; |
|
|
|
w.builtin = 1; |
|
|
|
w.builtin = 1; |
|
|
|
|
|
|
|
w.immediate = p->immediate; |
|
|
|
rv = fh_add_word(&w, fh); |
|
|
|
rv = fh_add_word(&w, fh); |
|
|
|
if (rv != FH_OK) { |
|
|
|
if (rv != FH_OK) { |
|
|
|
return rv; |
|
|
|
return rv; |
|
|
@ -535,11 +588,11 @@ enum fh_error fh_handle_quoted_string( |
|
|
|
TRY(ds_push(fh, len)); |
|
|
|
TRY(ds_push(fh, len)); |
|
|
|
break; |
|
|
|
break; |
|
|
|
case FH_SUBSTATE_DOTQUOTE: |
|
|
|
case FH_SUBSTATE_DOTQUOTE: |
|
|
|
printf("%.*s", (int) len, start); |
|
|
|
FHPRINT("%.*s", (int) len, start); |
|
|
|
break; |
|
|
|
break; |
|
|
|
|
|
|
|
|
|
|
|
default: |
|
|
|
default: |
|
|
|
printf("!!! Bad substate\r\n"); |
|
|
|
LOGE("Bad substate in interpret mode: %d", fh->substate); |
|
|
|
} |
|
|
|
} |
|
|
|
} else { |
|
|
|
} else { |
|
|
|
/* compile */ |
|
|
|
/* compile */ |
|
|
@ -578,13 +631,15 @@ enum fh_error fh_handle_word( |
|
|
|
while (w->handler) { |
|
|
|
while (w->handler) { |
|
|
|
if (0 == strncasecmp(start, w->name, len) && w->name[len]==0) { |
|
|
|
if (0 == strncasecmp(start, w->name, len) && w->name[len]==0) { |
|
|
|
// word found!
|
|
|
|
// word found!
|
|
|
|
if (fh->state == FH_STATE_COMPILE) { |
|
|
|
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)); |
|
|
|
TRY(fh_compile_reserve(fh, sizeof(struct fh_instruction_s), &addr)); |
|
|
|
instr.kind = FH_INSTR_WORD; |
|
|
|
instr.kind = FH_INSTR_WORD; |
|
|
|
instr.data = cnt; |
|
|
|
instr.data = cnt; |
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s)); |
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s)); |
|
|
|
} else { |
|
|
|
} else { |
|
|
|
/* interpret */ |
|
|
|
/* interpret */ |
|
|
|
|
|
|
|
LOG("Interpret word: %s", w->name); |
|
|
|
fh->exec_word = w; |
|
|
|
fh->exec_word = w; |
|
|
|
TRY(w->handler(fh)); |
|
|
|
TRY(w->handler(fh)); |
|
|
|
} |
|
|
|
} |
|
|
@ -595,143 +650,181 @@ enum fh_error fh_handle_word( |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
/* word not found, try parsing as number */ |
|
|
|
/* word not found, try parsing as number */ |
|
|
|
long v = strtol(start, NULL, 0); |
|
|
|
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) { |
|
|
|
if (fh->state == FH_STATE_COMPILE) { |
|
|
|
|
|
|
|
LOG("Compile number: %d", v); |
|
|
|
TRY(fh_compile_reserve(fh, sizeof(struct fh_instruction_s), &addr)); |
|
|
|
TRY(fh_compile_reserve(fh, sizeof(struct fh_instruction_s), &addr)); |
|
|
|
instr.kind = FH_INSTR_NUMBER; |
|
|
|
instr.kind = FH_INSTR_NUMBER; |
|
|
|
instr.data = (uint32_t) v; |
|
|
|
instr.data = (uint32_t) v; |
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s)); |
|
|
|
memcpy(&fh->compile[addr], &instr, sizeof(struct fh_instruction_s)); |
|
|
|
} else { |
|
|
|
} else { |
|
|
|
/* interpret */ |
|
|
|
/* interpret */ |
|
|
|
|
|
|
|
LOG("Interpret number: %d", v); |
|
|
|
TRY(ds_push(fh, (uint32_t)v)); |
|
|
|
TRY(ds_push(fh, (uint32_t)v)); |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
static bool iswhite(char c) |
|
|
|
static inline bool iswhite(char c) |
|
|
|
{ |
|
|
|
{ |
|
|
|
return c == ' ' || c == '\n' || c == '\t' || c == '\r'; |
|
|
|
return c == ' ' || c == '\n' || c == '\t' || c == '\r'; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
enum fh_error fh_process_input(struct fh_thread_s *fh) |
|
|
|
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; |
|
|
|
enum fh_error rv; |
|
|
|
char *rp = &fh->linebuf[fh->linebuf_readptr]; |
|
|
|
char *rp = linebuf; |
|
|
|
while (fh->linebuf_readptr < fh->linebuf_len && fh->state != FH_STATE_SHUTDOWN) { |
|
|
|
char c; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
LOGI("%s", linebuf); |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
while (0 != (c = *rp) && fh->state != FH_STATE_SHUTDOWN) { |
|
|
|
|
|
|
|
/* end on newline */ |
|
|
|
|
|
|
|
if (isnl(c)) { |
|
|
|
|
|
|
|
goto done; |
|
|
|
|
|
|
|
} |
|
|
|
/* skip whitespace */ |
|
|
|
/* skip whitespace */ |
|
|
|
char c = *rp; |
|
|
|
|
|
|
|
if (iswhite(c)) { |
|
|
|
if (iswhite(c)) { |
|
|
|
rp++; |
|
|
|
rp++; |
|
|
|
fh->linebuf_readptr++; |
|
|
|
|
|
|
|
continue; |
|
|
|
continue; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
char *end; |
|
|
|
char *end; |
|
|
|
size_t stringlen; |
|
|
|
size_t length; |
|
|
|
switch (fh->substate) { |
|
|
|
switch (fh->substate) { |
|
|
|
case FH_SUBSTATE_NONE: |
|
|
|
case FH_SUBSTATE_NONE: |
|
|
|
/* try read a word */ |
|
|
|
case FH_SUBSTATE_COLONNAME: |
|
|
|
|
|
|
|
/* try to read a word */ |
|
|
|
end = strchr(rp, ' '); |
|
|
|
end = strchr(rp, ' '); |
|
|
|
if (end) { |
|
|
|
if (end) { |
|
|
|
stringlen = end - rp; |
|
|
|
length = end - rp; /* exclude the space */ |
|
|
|
} else { |
|
|
|
} else { |
|
|
|
stringlen = fh->linebuf_len - fh->linebuf_readptr; |
|
|
|
length = strlen(rp); |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
// rtrim
|
|
|
|
if (fh->substate == FH_SUBSTATE_NONE) { |
|
|
|
while (stringlen > 0 && iswhite(rp[stringlen - 1])) { stringlen--; } |
|
|
|
/* eval a word */ |
|
|
|
|
|
|
|
LOG("Handle \"%.*s\"", (int)length, rp); |
|
|
|
TRY(fh_handle_word(fh, rp, stringlen)); |
|
|
|
TRY(fh_handle_word(fh, rp, length)); |
|
|
|
rp = end + 1; |
|
|
|
|
|
|
|
fh->linebuf_readptr = rp - &fh->linebuf[0]; |
|
|
|
|
|
|
|
break; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
case FH_SUBSTATE_COLONNAME: |
|
|
|
|
|
|
|
/* find space */ |
|
|
|
|
|
|
|
end = strchr(rp, ' '); |
|
|
|
|
|
|
|
stringlen = end - rp; |
|
|
|
|
|
|
|
if (end) { |
|
|
|
|
|
|
|
stringlen = end - rp; |
|
|
|
|
|
|
|
} else { |
|
|
|
} else { |
|
|
|
stringlen = fh->linebuf_len - fh->linebuf_readptr; |
|
|
|
/* new word's name is found */ |
|
|
|
|
|
|
|
LOG("New word name = \"%.*s\"", (int)length, rp); |
|
|
|
|
|
|
|
strncpy(fh->dict[fh->dict_top].name, rp, length); |
|
|
|
|
|
|
|
fh->substate = FH_SUBSTATE_NONE; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
// rtrim
|
|
|
|
if (end) { |
|
|
|
while (stringlen > 0 && iswhite(rp[stringlen - 1])) { stringlen--; } |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
strncpy(fh->dict[fh->dict_top].name, rp, stringlen); |
|
|
|
|
|
|
|
fh->substate = FH_SUBSTATE_NONE; |
|
|
|
|
|
|
|
rp = end + 1; |
|
|
|
rp = end + 1; |
|
|
|
fh->linebuf_readptr = rp - &fh->linebuf[0]; |
|
|
|
} else { |
|
|
|
|
|
|
|
goto done; |
|
|
|
|
|
|
|
} |
|
|
|
break; |
|
|
|
break; |
|
|
|
|
|
|
|
|
|
|
|
case FH_SUBSTATE_SQUOTE: |
|
|
|
case FH_SUBSTATE_SQUOTE: |
|
|
|
case FH_SUBSTATE_DOTQUOTE: |
|
|
|
case FH_SUBSTATE_DOTQUOTE: |
|
|
|
end = strchr(rp, '"'); |
|
|
|
end = strchr(rp, '"'); |
|
|
|
if (end) { |
|
|
|
if (end) { |
|
|
|
stringlen = end - rp - 1; |
|
|
|
length = end - rp - 1; |
|
|
|
TRY(fh_handle_quoted_string(fh, rp, stringlen)); |
|
|
|
LOG("Quoted string: \"%.*s\"", (int)length, rp); |
|
|
|
|
|
|
|
TRY(fh_handle_quoted_string(fh, rp, length)); |
|
|
|
fh->substate = FH_SUBSTATE_NONE; |
|
|
|
fh->substate = FH_SUBSTATE_NONE; |
|
|
|
rp = end + 1; |
|
|
|
rp = end + 1; |
|
|
|
fh->linebuf_readptr = rp - &fh->linebuf[0]; |
|
|
|
|
|
|
|
} else { |
|
|
|
} else { |
|
|
|
/* no end, discard all */ |
|
|
|
/* no end. this is weird. */ |
|
|
|
goto end; |
|
|
|
LOGE("Unterminated quoted string!"); |
|
|
|
|
|
|
|
goto done; |
|
|
|
} |
|
|
|
} |
|
|
|
break; |
|
|
|
break; |
|
|
|
|
|
|
|
|
|
|
|
case FH_SUBSTATE_PARENCOMMENT: |
|
|
|
case FH_SUBSTATE_PARENCOMMENT: |
|
|
|
end = strchr(rp, ')'); |
|
|
|
end = strchr(rp, ')'); |
|
|
|
if (end) { |
|
|
|
if (end) { |
|
|
|
|
|
|
|
LOG("Discard inline comment"); |
|
|
|
fh->substate = FH_SUBSTATE_NONE; |
|
|
|
fh->substate = FH_SUBSTATE_NONE; |
|
|
|
rp = end + 1; |
|
|
|
rp = end + 1; |
|
|
|
fh->linebuf_readptr = rp - &fh->linebuf[0]; |
|
|
|
|
|
|
|
} else { |
|
|
|
} else { |
|
|
|
/* no end, discard all */ |
|
|
|
/* no end, discard all */ |
|
|
|
goto end; |
|
|
|
LOGE("Unterminated parenthesis comment"); |
|
|
|
|
|
|
|
goto done; |
|
|
|
} |
|
|
|
} |
|
|
|
break; |
|
|
|
break; |
|
|
|
|
|
|
|
|
|
|
|
case FH_SUBSTATE_LINECOMMENT: |
|
|
|
case FH_SUBSTATE_LINECOMMENT: |
|
|
|
end = strchr(rp, '\n'); |
|
|
|
LOG("Discard line comment"); |
|
|
|
if (end) { |
|
|
|
goto done; // just discard the rest
|
|
|
|
fh->substate = FH_SUBSTATE_NONE; |
|
|
|
|
|
|
|
rp = end + 1; |
|
|
|
|
|
|
|
fh->linebuf_readptr = rp - &fh->linebuf[0]; |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
/* no newline, discard all */ |
|
|
|
|
|
|
|
goto end; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
break; |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
end: |
|
|
|
done: |
|
|
|
|
|
|
|
LOG("Line done."); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
int main() |
|
|
|
int main(int argc, char *argv[]) |
|
|
|
{ |
|
|
|
{ |
|
|
|
enum fh_error rv; |
|
|
|
enum fh_error rv; |
|
|
|
struct fh_thread_s fh; |
|
|
|
struct fh_thread_s fh; |
|
|
|
TRY_FAIL(fh_init_thread(&fh)); |
|
|
|
rv = fh_init_thread(&fh); |
|
|
|
|
|
|
|
if (rv != FH_OK) { |
|
|
|
|
|
|
|
LOGE("Error in forth init: %s", fherr_name(rv)); |
|
|
|
|
|
|
|
return 1; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
while (fh.state != FH_STATE_SHUTDOWN && fgets(fh.linebuf, MAXLINE, stdin)) { |
|
|
|
bool interactive = true; |
|
|
|
fh.linebuf_len = strlen(fh.linebuf); |
|
|
|
FILE *infile = stdin; |
|
|
|
fh.linebuf_readptr = 0; |
|
|
|
|
|
|
|
rv = fh_process_input(&fh); |
|
|
|
// TODO use getopt?
|
|
|
|
if (rv == FH_OK) { |
|
|
|
for (int a = 1; a < argc; a++) { |
|
|
|
printf("ok\r\n"); |
|
|
|
if (argv[a][0] == '-') { |
|
|
|
|
|
|
|
// opt
|
|
|
|
} else { |
|
|
|
} else { |
|
|
|
printf("ERROR %d\r\n", rv); |
|
|
|
infile = fopen(argv[a], "r"); |
|
|
|
|
|
|
|
interactive = false; |
|
|
|
|
|
|
|
if (!infile) { |
|
|
|
|
|
|
|
LOGE("Error opening infile: %s", argv[a]); |
|
|
|
|
|
|
|
return 1; |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
printf("Bye.\r\n"); |
|
|
|
/* process input line by line */ |
|
|
|
return 0; |
|
|
|
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; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
fail: |
|
|
|
rv = fh_process_line(&fh, linebuf); |
|
|
|
printf("Error %d\r\n", rv); |
|
|
|
if (rv == FH_OK) { |
|
|
|
|
|
|
|
FHPRINT("ok\r\n"); |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
LOGE("ERROR %s on line %d", fherr_name(rv), linecnt); |
|
|
|
return 1; |
|
|
|
return 1; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
FHPRINT("Bye.\r\n"); |
|
|
|
|
|
|
|
return 0; |
|
|
|
} |
|
|
|
} |
|
|
|