MightyPork
/
forth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

postpone works now

Browse Source
master
Ondřej Hruška 3 years ago
parent 1be97e4f0e
commit 2f0f1877fe
Signed by: MightyPork
GPG Key ID: 2C5FD5035250423D
5 changed files with 319 additions and 169 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 4
      if.forth
  2. 28
      include/fh_runtime.h
  3. 9
      postpone.forth
  4. 59
      src/fh_builtins.c
  5. 204
      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

59
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,6 +912,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
};
const struct name_and_handler builtins[] = {
{"", w_error_word0, 1, 0},
{"s\"", w_s_quote, 1, 0},
{".\"", w_dot_quote, 1, 0},
/* Compiler control words */
@ -969,6 +1005,8 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
{"(", 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;

204
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,6 +155,10 @@ 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;
@ -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,40 +247,55 @@ static enum fh_error fh_handle_quoted_string(
return FH_OK;
}
/** Process a word read from input */
static enum fh_error fh_handle_word(
struct fh_thread_s *fh,
const char *start,
const size_t wordlen
)
enum fh_error fh_handle_word(struct fh_thread_s *fh, const struct fh_word_s *w)
{
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);
instr_init(&instr, FH_INSTR_WORD, w->index);
TRY(fh_compile_put(fh, &instr, INSTR_SIZE));
} else {
/* interpret */
LOG("Interpret word: %s", w->name);
/* 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 */
enum fh_error fh_handle_ascii_word(
struct fh_thread_s *fh,
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 */
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 */
errno = 0;
@ -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!
struct fh_word_s *w = find_word(fh, name, wordlen);
if (!w) {
return FH_ERR_UNKNOWN_WORD;
}
show_word(fh, w);
return FH_OK;
}
w++;
cnt++;
}
}
/** Postpone a word */
static enum fh_error fh_postpone_word(
struct fh_thread_s *fh,
const char *name,
const size_t wordlen
)
{
struct fh_word_s *w = find_word(fh, name, wordlen);
if (!w) {
return FH_ERR_UNKNOWN_WORD;
}
enum fh_error rv;
struct fh_instruction_s instr;
LOG("Postpone %s", w->name);
instr_init(&instr, FH_INSTR_POSTPONED_WORD, w->index);
TRY(fh_compile_put(fh, &instr, INSTR_SIZE));
return FH_OK;
}
/** 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) {
switch (fh->substate) {
case 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) {
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);
} else if (fh->substate == FH_SUBSTATE_SEENAME) {
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