Your ROOT_URL in app.ini is https://git.ondrovo.com/ but you are visiting http://159.69.29.240:49153/MightyPork/forth/commit/2f0f1877fe560d4c93dd7ae2205740b4d5a6052b You should set ROOT_URL correctly, otherwise the web may not work correctly.
MightyPork
/
forth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

postpone works now

Browse Source
master
Ondřej Hruška 4 years ago
parent 1be97e4f0e
commit 2f0f1877fe
Signed by: MightyPork
GPG Key ID: 2C5FD5035250423D
5 changed files with 319 additions and 169 deletions
  1. 4
      if.forth
  2. 28
      include/fh_runtime.h
  3. 9
      postpone.forth
  4. 215
      src/fh_builtins.c
  5. 232
      src/fh_runtime.c

4
if.forth
Unescape View File

@ -0,0 +1,4 @@
: yesno IF ." yes" ELSE ." no" THEN ;
1 yesno
0 yesno

28
include/fh_runtime.h
Unescape View File

@ -43,6 +43,9 @@ enum fb_instruction_kind {
/* Jump if zero */
FH_INSTR_JUMPZERO,
/* Postponed word */
FH_INSTR_POSTPONED_WORD,
};
/** One instruction in bytecode */
@ -65,9 +68,13 @@ _Static_assert(sizeof(struct fh_instruction_s) % 4 == 0, "Instruction struct is
/** Forth runtime major state */
enum fh_state {
/** Interactive interpret mode */
FH_STATE_INTERPRET = 0,
/** Compiling */
FH_STATE_COMPILE,
/** Quit from RUN to interpret */
FH_STATE_QUIT,
/** Shutting down the runtime */
FH_STATE_SHUTDOWN,
FH_STATE_MAX,
};
@ -75,18 +82,20 @@ enum fh_state {
/** 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_COLON_NAME,
FH_SUBSTATE_S_QUOTE,
FH_SUBSTATE_DOT_QUOTE,
FH_SUBSTATE_PAREN_COMMENT,
FH_SUBSTATE_LINE_COMMENT,
FH_SUBSTATE_EXIT,
FH_SUBSTATE_SEENAME,
FH_SUBSTATE_SEE_NAME,
FH_SUBSTATE_POSTPONE_NAME,
FH_SUBSTATE_MAX,
};
/** Word struct as they are stored in the dictionary */
struct fh_word_s {
uint32_t index;
/** Word name */
char name[MAX_NAME_LEN];
/**
@ -185,5 +194,12 @@ _Static_assert(WORDALIGNED(1024) == 1024, "word align");
if (FH_OK != (rv = (x))) return rv; \
} while (0)
enum fh_error fh_handle_ascii_word(
struct fh_thread_s *fh,
const char *name,
size_t wordlen
);
enum fh_error fh_handle_word(struct fh_thread_s *fh, const struct fh_word_s *w);
#endif //FORTH_FH_RUNTIME_H

9
postpone.forth
Unescape View File

@ -0,0 +1,9 @@
: ENDIF POSTPONE THEN ; IMMEDIATE
: yesno IF ." yes" ELSE ." no" ENDIF ;
see ENDIF
see yesno
1 yesno
0 yesno

215
src/fh_builtins.c
Unescape View File

@ -293,13 +293,25 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
(void) w;
ENSURE_STATE(FH_STATE_INTERPRET);
fh_setstate(fh, FH_STATE_COMPILE, FH_SUBSTATE_COLONNAME);
fh_setstate(fh, FH_STATE_COMPILE, FH_SUBSTATE_COLON_NAME);
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;
struct fh_word_s *new_word = &fh->dict[fh->dict_top];
new_word->index = fh->dict_top;
new_word->start = fh->compile_top;
new_word->handler = w_user_word;
return FH_OK;
}
static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
ENSURE_STATE(FH_STATE_COMPILE);
fh_setsubstate(fh, FH_SUBSTATE_POSTPONE_NAME);
return FH_OK;
}
@ -337,6 +349,21 @@ static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s
return FH_OK;
}
static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
if (fh->dict_top == 0) {
LOGE("Dict is empty, cannot modify previous word!");
return FH_ERR_INVALID_STATE;
}
fh->dict[fh->dict_top - 1].immediate = 1;
return FH_OK;
}
static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
@ -669,28 +696,36 @@ static enum fh_error w_exit(struct fh_thread_s *fh, const struct fh_word_s *w)
static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
fh_setsubstate(fh, FH_SUBSTATE_SQUOTE);
fh_setsubstate(fh, FH_SUBSTATE_S_QUOTE);
return FH_OK;
}
static enum fh_error w_error_word0(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
LOGE("Invocation of word #0 (illegal)");
fh_setstate(fh, FH_STATE_QUIT, 0);
return FH_OK;
}
static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
fh_setsubstate(fh, FH_SUBSTATE_DOTQUOTE);
fh_setsubstate(fh, FH_SUBSTATE_DOT_QUOTE);
return FH_OK;
}
static enum fh_error w_backslash(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
fh_setsubstate(fh, FH_SUBSTATE_LINECOMMENT);
fh_setsubstate(fh, FH_SUBSTATE_LINE_COMMENT);
return FH_OK;
}
static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
fh_setsubstate(fh, FH_SUBSTATE_PARENCOMMENT);
fh_setsubstate(fh, FH_SUBSTATE_PAREN_COMMENT);
return FH_OK;
}
@ -725,7 +760,7 @@ static enum fh_error w_else(struct fh_thread_s *fh, const struct fh_word_s *w)
uint32_t ifaddr = 0;
TRY(cs_pop(fh, &ifaddr));
struct fh_instruction_s *if_instr = (void*) &fh->compile[ifaddr];
struct fh_instruction_s *if_instr = (void *) &fh->compile[ifaddr];
if (if_instr->data != MAGICADDR_UNRESOLVED) {
LOGE("IF-ELSE control stack corruption");
return FH_ERR_INTERNAL;
@ -749,7 +784,7 @@ static enum fh_error w_then(struct fh_thread_s *fh, const struct fh_word_s *w)
uint32_t ifaddr = 0;
TRY(cs_pop(fh, &ifaddr));
struct fh_instruction_s *if_instr = (void*) &fh->compile[ifaddr];
struct fh_instruction_s *if_instr = (void *) &fh->compile[ifaddr];
if (if_instr->data != MAGICADDR_UNRESOLVED) {
LOGE("IF-ELSE control stack corruption");
return FH_ERR_INTERNAL;
@ -781,7 +816,7 @@ static enum fh_error w_emit(struct fh_thread_s *fh, const struct fh_word_s *w)
static enum fh_error w_see(struct fh_thread_s *fh, const struct fh_word_s *w)
{
enum fh_error rv;
fh_setsubstate(fh, FH_SUBSTATE_SEENAME);
fh_setsubstate(fh, FH_SUBSTATE_SEE_NAME);
return FH_OK;
}
@ -877,99 +912,102 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
};
const struct name_and_handler builtins[] = {
{"s\"", w_s_quote, 1, 0},
{".\"", w_dot_quote, 1, 0},
{"", w_error_word0, 1, 0},
{"s\"", w_s_quote, 1, 0},
{".\"", w_dot_quote, 1, 0},
/* Compiler control words */
{"bye", w_bye, 0, 0},
{"bye", w_bye, 0, 0},
/* Pointers */
{"@", w_fetch, 0, 0},
{"!", w_store, 0, 0},
{"2!", w_two_store, 0, 0},
{"2@", w_two_fetch, 0, 0},
{"@", w_fetch, 0, 0},
{"!", w_store, 0, 0},
{"2!", w_two_store, 0, 0},
{"2@", w_two_fetch, 0, 0},
// TODO +!
// TODO pictured numbers (#)
// TODO tick
// TODO comma
// TODO >BODY, >IN, >NUMBER
/* Arithmetics */
{"decimal", wp_setbase, 0, 10},
{"hex", wp_setbase, 0, 16},
{"base", wp_const, 0, MAGICADDR_BASE},
{"false", wp_const, 0, 0},
{"true", wp_const, 0, 0xFFFFFFFF},
{"depth", w_depth, 0, 0},
{"+", w_plus, 0, 0},
{"-", w_minus, 0, 0},
{"*", w_star, 0, 0},
{"*/", w_star_slash, 0, 0},
{"*/mod", w_star_slash_mod, 0, 0},
{"/", w_slash, 0, 0},
{"/mod", w_slash_mod, 0, 0},
{"0<", w_zero_less, 0, 0},
{"0=", w_zero_equals, 0, 0},
{"0<>", w_zero_not_equals, 0, 0},
{"0>", w_zero_greater, 0, 0},
{"<", w_less, 0, 0},
{"=", w_equals, 0, 0},
{"<>", w_not_equals, 0, 0},
{">", w_greater, 0, 0},
{"1+", wp_add, 0, 1},
{"char+", wp_add, 0, 1},
{"1-", wp_add, 0, -1},
{"2+", wp_add, 0, 2},
{"2-", wp_add, 0, -2},
{"2*", wp_mul, 0, 2},
{"chars", wp_mul, 0, 1},
{"2/", wp_div, 0, 2},
{"cells", wp_mul, 0, CELL},
{"cell+", wp_add, 0, CELL},
{"decimal", wp_setbase, 0, 10},
{"hex", wp_setbase, 0, 16},
{"base", wp_const, 0, MAGICADDR_BASE},
{"false", wp_const, 0, 0},
{"true", wp_const, 0, 0xFFFFFFFF},
{"depth", w_depth, 0, 0},
{"+", w_plus, 0, 0},
{"-", w_minus, 0, 0},
{"*", w_star, 0, 0},
{"*/", w_star_slash, 0, 0},
{"*/mod", w_star_slash_mod, 0, 0},
{"/", w_slash, 0, 0},
{"/mod", w_slash_mod, 0, 0},
{"0<", w_zero_less, 0, 0},
{"0=", w_zero_equals, 0, 0},
{"0<>", w_zero_not_equals, 0, 0},
{"0>", w_zero_greater, 0, 0},
{"<", w_less, 0, 0},
{"=", w_equals, 0, 0},
{"<>", w_not_equals, 0, 0},
{">", w_greater, 0, 0},
{"1+", wp_add, 0, 1},
{"char+", wp_add, 0, 1},
{"1-", wp_add, 0, -1},
{"2+", wp_add, 0, 2},
{"2-", wp_add, 0, -2},
{"2*", wp_mul, 0, 2},
{"chars", wp_mul, 0, 1},
{"2/", wp_div, 0, 2},
{"cells", wp_mul, 0, CELL},
{"cell+", wp_add, 0, CELL},
/* Stack manip */
{"drop", w_drop, 0, 0},
{"dup", w_dupe, 0, 0},
{"nip", w_nip, 0, 0},
{"?dup", w_question_dupe, 0, 0},
{"over", w_over, 0, 0},
{"swap", w_swap, 0, 0},
{"rot", w_rot, 0, 0},
{"tuck", w_tuck, 0, 0},
{"pick", w_pick, 0, 0},
{"roll", w_roll, 0, 0},
{"drop", w_drop, 0, 0},
{"dup", w_dupe, 0, 0},
{"nip", w_nip, 0, 0},
{"?dup", w_question_dupe, 0, 0},
{"over", w_over, 0, 0},
{"swap", w_swap, 0, 0},
{"rot", w_rot, 0, 0},
{"tuck", w_tuck, 0, 0},
{"pick", w_pick, 0, 0},
{"roll", w_roll, 0, 0},
/* Double wide stack manip */
{"2drop", w_two_drop, 0, 0},
{"2dup", w_two_dup, 0, 0},
{"2over", w_two_over, 0, 0},
{"2swap", w_two_swap, 0, 0},
{"2drop", w_two_drop, 0, 0},
{"2dup", w_two_dup, 0, 0},
{"2over", w_two_over, 0, 0},
{"2swap", w_two_swap, 0, 0},
/* Return stack manip */
{">r", w_to_r, 0, 0},
{"r>", w_r_from, 0, 0},
{"r@", w_r_fetch, 0, 0},
{">r", w_to_r, 0, 0},
{"r>", w_r_from, 0, 0},
{"r@", w_r_fetch, 0, 0},
/* Double wide return stack manip */
{"2>r", w_two_to_r, 0, 0},
{"2r>", w_two_r_from, 0, 0},
{"2r@", w_two_r_fetch, 0, 0},
{"2>r", w_two_to_r, 0, 0},
{"2r>", w_two_r_from, 0, 0},
{"2r@", w_two_r_fetch, 0, 0},
/* Printing */
{".", w_dot, 0, 0},
{"type", w_type, 0, 0},
{"cr", wp_putc, 0, '\n'},
{"space", wp_putc, 0, ' '},
{"bl", wp_const, 0, ' '},
{"??", w_debug_dump, 0, 0},
{"emit", w_emit, 0, 0},
{".", w_dot, 0, 0},
{"type", w_type, 0, 0},
{"cr", wp_putc, 0, '\n'},
{"space", wp_putc, 0, ' '},
{"bl", wp_const, 0, ' '},
{"??", w_debug_dump, 0, 0},
{"emit", w_emit, 0, 0},
/* Control flow */
{"abort", w_abort, 0, 0},
{"quit", w_quit, 0, 0},
{"exit", w_exit, 0, 0},
{"if", w_if, 1, 0},
{"else", w_else, 1, 0},
{"then", w_then, 1, 0},
{"abort", w_abort, 0, 0},
{"quit", w_quit, 0, 0},
{"exit", w_exit, 0, 0},
{"if", w_if, 1, 0},
{"else", w_else, 1, 0},
{"then", w_then, 1, 0},
/* Syntax */
{":", w_colon, 0, 0},
{";", w_semicolon, 1, 0},
{"\\", w_backslash, 1, 0}, // line comment
{"(", w_paren, 1, 0}, // enclosed comment
{"recurse", w_recurse, 1, 0},
{"reset", w_reset, 1, 0},
{"see", w_see, 0, 0},
{":", w_colon, 0, 0},
{";", w_semicolon, 1, 0},
{"\\", w_backslash, 1, 0}, // line comment
{"(", w_paren, 1, 0}, // enclosed comment
{"recurse", w_recurse, 1, 0},
{"reset", w_reset, 1, 0},
{"immediate", w_immediate, 1, 0},
{"postpone", w_postpone, 1, 0},
{"see", w_see, 0, 0},
{ /* end marker */ }
};
@ -980,6 +1018,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
enum fh_error rv;
while (p->handler) {
strcpy(w.name, p->name);
w.index = fh->dict_top;
w.handler = p->handler;
w.builtin = 1;
w.immediate = p->immediate;

232
src/fh_runtime.c
Unescape View File

@ -16,19 +16,21 @@ struct fh_global_s fh_globals = {};
static const char *statenames[FH_STATE_MAX] = {
[FH_STATE_INTERPRET] = "INTERPRET",
[FH_STATE_COMPILE] = "COMPILE",
[FH_STATE_QUIT] = "RUN",
[FH_STATE_SHUTDOWN] = "SHUTDOWN",
};
/** Sub-state names */
static const char *substatenames[FH_SUBSTATE_MAX] = {
[FH_SUBSTATE_NONE] = "NONE",
[FH_SUBSTATE_COLONNAME] = "COLONNAME",
[FH_SUBSTATE_SQUOTE] = "SQUOTE",
[FH_SUBSTATE_DOTQUOTE] = "DOTQUOTE",
[FH_SUBSTATE_PARENCOMMENT] = "PARENCOMMENT",
[FH_SUBSTATE_LINECOMMENT] = "LINECOMMENT",
[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",
[FH_SUBSTATE_EXIT] = "EXIT",
[FH_SUBSTATE_SEENAME] = "SEENAME",
[FH_SUBSTATE_SEE_NAME] = "SEE_NAME",
[FH_SUBSTATE_POSTPONE_NAME] = "POSTPONE_NAME",
};
/** Add a word to the dictionary. */
@ -96,15 +98,34 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
uint32_t strl;
uint32_t val;
uint32_t addr = 0;
struct fh_instruction_s instr2;
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;
case FH_INSTR_WORD:
w2 = &fh->dict[instr->data];
if (w2->builtin) {
LOG("Exec: builtin-word %s", w2->name);
LOG("Exec: builtin-word \"%s\"", w2->name);
w2->handler(fh, w2);
if (fh->substate == FH_SUBSTATE_EXIT) {
fh_setsubstate(fh, 0);
@ -122,6 +143,11 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
}
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;
@ -129,10 +155,14 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
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 */
/* special case for strings stored in compile memory */
case FH_INSTR_ALLOCSTR:
case FH_INSTR_TYPESTR:
strl = instr->data;
@ -191,12 +221,12 @@ static enum fh_error fh_handle_quoted_string(
if (fh->state == FH_STATE_INTERPRET) {
switch (fh->substate) {
case FH_SUBSTATE_SQUOTE:
case FH_SUBSTATE_S_QUOTE:
TRY(fh_heap_put(fh, start, len));
TRY(ds_push(fh, addr));
TRY(ds_push(fh, len));
break;
case FH_SUBSTATE_DOTQUOTE:
case FH_SUBSTATE_DOT_QUOTE:
FHPRINT("%.*s", (int) len, start);
break;
@ -206,7 +236,7 @@ static enum fh_error fh_handle_quoted_string(
} else {
LOG("Compile a string");
/* compile */
if (fh->substate == FH_SUBSTATE_SQUOTE) {
if (fh->substate == FH_SUBSTATE_S_QUOTE) {
instr_init(&instr, FH_INSTR_ALLOCSTR, len);
} else {
instr_init(&instr, FH_INSTR_TYPESTR, len);
@ -217,39 +247,54 @@ static enum fh_error fh_handle_quoted_string(
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;
}
/** Process a word read from input */
static enum fh_error fh_handle_word(
enum fh_error fh_handle_ascii_word(
struct fh_thread_s *fh,
const char *start,
const char *name,
const size_t wordlen
)
{
enum fh_error rv;
if (wordlen >= 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, wordlen) && w->name[wordlen] == 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);
TRY(w->handler(fh, w));
}
return FH_OK;
}
w++;
cnt++;
struct fh_word_s *w = find_word(fh, name, wordlen);
if (w) {// word found!
TRY(fh_handle_word(fh, w));
return FH_OK;
}
/* word not found, try parsing as number */
@ -258,22 +303,23 @@ static enum fh_error fh_handle_word(
int base = (int) fh->base;
// prefix can override BASE - this is a syntax extension
if (start[0] == '0') {
if (start[1] == 'x') {
if (name[0] == '0') {
if (name[1] == 'x') {
base = 16;
} else if (start[1] == 'b') {
} else if (name[1] == 'b') {
base = 2;
} else if (start[1] == 'o') {
} else if (name[1] == 'o') {
base = 8;
}
}
long v = strtol(start, &endptr, base); // XXX if base is 0, this will use auto-detection
if (errno != 0 || (endptr - start) != wordlen) {
LOGE("Unknown word and fail to parse as number: %.*s", (int) wordlen, start);
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);
return FH_ERR_UNKNOWN_WORD;
}
struct fh_instruction_s instr;
if (fh->state == FH_STATE_COMPILE) {
LOG("Compile number: %ld", v);
instr_init(&instr, FH_INSTR_NUMBER, (uint32_t) v);
@ -287,7 +333,8 @@ static enum fh_error fh_handle_word(
return FH_OK;
}
static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w) {
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;
@ -307,9 +354,21 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w) {
goto instr;
case FH_INSTR_WORD:
wn = instr->data;
w2 = &fh->dict[instr->data];
FHPRINT("Call(%s, 0x%08x)\n", w2->name, 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:
@ -346,23 +405,37 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w) {
/** Decompile a word */
static enum fh_error fh_see_word(
struct fh_thread_s *fh,
const char *start,
const char *name,
const size_t wordlen
)
{
struct fh_word_s *w = &fh->dict[0];
uint32_t cnt = 0;
enum fh_error rv;
while (w->handler) {
if (0 == strncasecmp(start, w->name, wordlen) && w->name[wordlen] == 0) {
// word found!
show_word(fh, w);
return FH_OK;
}
w++;
cnt++;
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;
}
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;
}
/** True if the character is CR or LF */
@ -397,8 +470,9 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf)
size_t length;
switch (fh->substate) {
case FH_SUBSTATE_NONE:
case FH_SUBSTATE_COLONNAME:
case FH_SUBSTATE_SEENAME:
case FH_SUBSTATE_COLON_NAME:
case FH_SUBSTATE_SEE_NAME:
case FH_SUBSTATE_POSTPONE_NAME:
/* try to read a word */
end = strchr(rp, ' ');
if (end) {
@ -407,18 +481,26 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf)
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 if (fh->substate == FH_SUBSTATE_COLONNAME) {
/* 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);
} else if (fh->substate == FH_SUBSTATE_SEENAME) {
TRY(fh_see_word(fh, rp, length));
fh_setsubstate(fh, FH_SUBSTATE_NONE);
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;
}
if (end) {
@ -428,8 +510,8 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf)
}
break;
case FH_SUBSTATE_SQUOTE:
case FH_SUBSTATE_DOTQUOTE:
case FH_SUBSTATE_S_QUOTE:
case FH_SUBSTATE_DOT_QUOTE:
end = strchr(rp, '"');
if (end) {
length = end - rp;
@ -444,7 +526,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf)
}
break;
case FH_SUBSTATE_PARENCOMMENT:
case FH_SUBSTATE_PAREN_COMMENT:
end = strchr(rp, ')');
if (end) {
LOG("Discard inline comment");
@ -457,7 +539,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf)
}
break;
case FH_SUBSTATE_LINECOMMENT:
case FH_SUBSTATE_LINE_COMMENT:
LOG("Discard line comment");
goto done; // just discard the rest

Write Preview
Loading…
Cancel
Save