fix implementation of ABORT, ABORT" and QUIT

master
Ondřej Hruška 3 years ago
parent 002c9cb100
commit 56ab10f6c8
  1. 8
      README.md
  2. 2
      include/fh_builtins.h
  3. 1
      include/fh_error.h
  4. 6
      include/fh_parse.h
  5. 15
      include/fh_runtime.h
  6. 64
      src/fh_builtins_control.c
  7. 145
      src/fh_builtins_meta.c
  8. 8
      src/fh_builtins_text.c
  9. 1
      src/fh_error.c
  10. 26
      src/fh_parse.c
  11. 54
      src/fh_runtime.c
  12. 16
      src/fh_see.c
  13. 2
      src/main.c
  14. 4
      testfiles/abort.f
  15. 1
      testfiles/combinedtest.f

@ -49,13 +49,13 @@ Implemented and tested:
``` ```
CORE: CORE:
! ' ( * */ */MOD + +! +LOOP , - . ." # #> #S <# >BODY >NUMBER / /mod 0< 0= 1+ 1- 2! 2* 2/ 2@ 2DROP 2DUP 2OVER 2SWAP ! ' ( * */ */MOD + +! +LOOP , - . ." # #> #S <# >BODY >NUMBER / /mod 0< 0= 1+ 1- 2! 2* 2/ 2@ 2DROP 2DUP 2OVER 2SWAP
: ; < = > >IN >R ?DUP @ ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+ : ; < = > >IN >R ?DUP @ ABORT ABORT" ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+
CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DOES> DROP DUP ELSE EMIT ENVIRONMENT? EVALUATE EXECUTE EXIT FILL FM/MOD FIND CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DOES> DROP DUP ELSE EMIT ENVIRONMENT? EVALUATE EXECUTE EXIT FILL FM/MOD FIND
HERE HOLD I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD MOVE NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE HERE HOLD I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD MOVE NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE
REPEAT ROT RSHIFT S>D S" SIGN SM/REM SOURCE SPACE SPACES STATE SWAP THEN TYPE U. U< UNTIL UM* UM/MOD UNLOOP VARIABLE WHILE WORD XOR [ ['] [CHAR] ] REPEAT ROT RSHIFT S>D S" SIGN SM/REM SOURCE SPACE SPACES STATE SWAP THEN TYPE U. U< UNTIL UM* UM/MOD UNLOOP VARIABLE WHILE WORD XOR [ ['] [CHAR] ]
CORE-EXT: CORE-EXT:
.( .R :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN BUFFER: C" CASE COMPILE, ENDCASE ENDOF ERASE FALSE HEX HOLDS MARKER NIP OF PAD PARSE PARSE-NAME PICK RESTORE-INPUT SAVE-INPUT ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN .( .R :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO ACTION-OF AGAIN BUFFER: C" CASE COMPILE, DEFER DEFER! DEFER@ ENDCASE ENDOF ERASE FALSE HEX HOLDS IS MARKER NIP OF PAD PARSE PARSE-NAME PICK RESTORE-INPUT SAVE-INPUT ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN
\ \
Other sets: Other sets:
@ -66,10 +66,10 @@ Missing:
``` ```
CORE: CORE:
ABORT ABORT" ACCEPT KEY ACCEPT KEY
CORE-EXT: CORE-EXT:
ACTION-OF DEFER DEFER! DEFER@ IS REFILL SOURCE-ID [COMPILE] REFILL SOURCE-ID [COMPILE]
``` ```
. .

@ -22,7 +22,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh);
#define ENSURE_STATE(__state) do { \ #define ENSURE_STATE(__state) do { \
if (fh->state != (__state)) { \ if (fh->state != (__state)) { \
LOGE("Invalid state %d, expected %d", fh->state, (__state)); \ LOGE("Invalid state %d, expected %d in file " __FILE__ " line %d", fh->state, (__state), __LINE__); \
return FH_ERR_INVALID_STATE; \ return FH_ERR_INVALID_STATE; \
} \ } \
} while (0) } while (0)

@ -29,6 +29,7 @@ enum fh_error {
FH_ERR_SYNTAX, FH_ERR_SYNTAX,
FH_ERR_NOT_APPLICABLE, FH_ERR_NOT_APPLICABLE,
FH_ERR_PICTNUM_FULL, FH_ERR_PICTNUM_FULL,
FH_ERR_BAD_DEFER,
FH_ERR_MAX, FH_ERR_MAX,
}; };

@ -21,4 +21,10 @@ enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, c
enum fh_error fh_handle_ascii_word(struct fh_thread_s *fh, const char *name, size_t wordlen); enum fh_error fh_handle_ascii_word(struct fh_thread_s *fh, const char *name, size_t wordlen);
// chartest space or 0, param is ignored
bool fh_chartest_space_or_end(char c, void *param);
// chartest given char or 0. param is pointer to char.
bool fh_chartest_equals_or_end(char c, void *param);
#endif //FORTH_FH_PARSE_H #endif //FORTH_FH_PARSE_H

@ -43,6 +43,9 @@ enum fh_instruction_kind {
/** This is the `."` instruction, same format as above. */ /** This is the `."` instruction, same format as above. */
FH_INSTR_TYPESTR, FH_INSTR_TYPESTR,
/** abort" in compiled form */
FH_INSTR_ABORTSTR,
/* Unconditional jump */ /* Unconditional jump */
FH_INSTR_JUMP, FH_INSTR_JUMP,
@ -77,11 +80,21 @@ enum fh_instruction_kind {
/* Postponed word */ /* Postponed word */
FH_INSTR_POSTPONED_WORD, FH_INSTR_POSTPONED_WORD,
/* Action-of in compiled form */
FH_INSTR_ACTIONOF,
/* IS in compiled form */
FH_INSTR_ISDEFER,
FH_INSTR_MAX, FH_INSTR_MAX,
}; };
const char *instr_name(enum fh_instruction_kind kind); const char *instr_name(enum fh_instruction_kind kind);
void fh_quit(struct fh_thread_s *fh);
void fh_abort(struct fh_thread_s *fh);
void fh_drop_to_interactive(struct fh_thread_s *fh);
/** One instruction in bytecode */ /** One instruction in bytecode */
struct fh_instruction_s { struct fh_instruction_s {
/** What is the meaning of data? */ /** What is the meaning of data? */
@ -133,6 +146,8 @@ extern const char *substatenames[FH_SUBSTATE_MAX];
#define WORDFLAG_CREATED 0x20 #define WORDFLAG_CREATED 0x20
/** Word marked as hidden is not findable, e.g. because it is being compiled. */ /** Word marked as hidden is not findable, e.g. because it is being compiled. */
#define WORDFLAG_HIDDEN 0x40 #define WORDFLAG_HIDDEN 0x40
/** Created using DEFER */
#define WORDFLAG_DEFER 0x80
/** Word struct as they are stored in the dictionary */ /** Word struct as they are stored in the dictionary */
struct fh_word_s { struct fh_word_s {

@ -244,6 +244,67 @@ static enum fh_error w_of(struct fh_thread_s *fh, const struct fh_word_s *w)
return FH_OK; return FH_OK;
} }
static enum fh_error w_abort(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
fh_abort(fh);
return FH_OK;
}
static enum fh_error w_quit(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
fh_quit(fh);
return FH_OK;
}
static enum fh_error w_abort_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
size_t len;
// this is copied from ."
// leave space for the instr in case of compiled version
uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE);
/* read the string straight into HEAP, but don't advance the heap pointer, so the string is immediately discarded again */
fh_input_consume_spaces(fh);
char *start;
uint32_t capacity = HEAP_END - addr;
start = NULL;
char c = '"';
TRY(fh_input_read_delimited(fh, &start, &len, fh_chartest_equals_or_end, &c));
if (len > capacity) {
LOGE("String too long for heap");
return FH_ERR_HEAP_FULL;
}
if (fh->state == FH_STATE_COMPILE) {
fh_heap_copyptr(fh, addr, start, len);
}
if (fh->state == FH_STATE_INTERPRET) {
uint32_t val;
TRY(ds_pop(fh, &val));
if (val) {
FHPRINT("%.*s", (int) len, start);
fh_abort(fh);
}
// the string is invalidated immediately, heap pointer is NOT advanced.
} else {
LOG("Compile abort string: \"%.*s\"", (int) len, start);
TRY(fh_put_instr(fh, FH_INSTR_ABORTSTR, len));
fh->here = WORDALIGNED(addr + len); // at the end of the string
}
return FH_OK;
}
static enum fh_error w_endof(struct fh_thread_s *fh, const struct fh_word_s *w) static enum fh_error w_endof(struct fh_thread_s *fh, const struct fh_word_s *w)
{ {
(void) w; (void) w;
@ -310,6 +371,9 @@ const struct name_and_handler fh_builtins_control[] = {
{"else", w_else, 1, 0}, {"else", w_else, 1, 0},
{"then", w_then, 1, 0}, {"then", w_then, 1, 0},
{"recurse", w_recurse, 1, 0}, {"recurse", w_recurse, 1, 0},
{"quit", w_quit, 0, 0},
{"abort", w_abort, 0, 0},
{"abort\"", w_abort_quote, 1, 0},
{"do", wp_do, 1, 0}, {"do", wp_do, 1, 0},
{"?do", wp_do, 1, 1}, {"?do", wp_do, 1, 1},
{"loop", wp_loop, 1, 0}, {"loop", wp_loop, 1, 0},

@ -38,6 +38,17 @@ static enum fh_error rt_marker(struct fh_thread_s *fh, const struct fh_word_s *w
return FH_OK; return FH_OK;
} }
static enum fh_error rt_defer(struct fh_thread_s *fh, const struct fh_word_s *w)
{
uint32_t defered = w->param;
if (defered == MAGICADDR_UNRESOLVED) {
LOGE("Exec DEFER name without assigned xt!");
return FH_ERR_BAD_DEFER;
}
return fh_handle_word(fh, defered);
}
static enum fh_error w_marker(struct fh_thread_s *fh, const struct fh_word_s *w) static enum fh_error w_marker(struct fh_thread_s *fh, const struct fh_word_s *w)
{ {
(void) w; (void) w;
@ -512,6 +523,135 @@ static enum fh_error w_create(struct fh_thread_s *fh, const struct fh_word_s *w)
return FH_OK; return FH_OK;
} }
static enum fh_error w_defer(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_INTERPRET);
char *wordname;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
uint32_t ptr;
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
struct fh_word_s *new_word = fh_word_at(fh, ptr);
if (!new_word) { return FH_ERR_INTERNAL; }
new_word->previous = fh->dict_last;
new_word->param = MAGICADDR_UNRESOLVED;
new_word->handler = rt_defer;
strncpy(new_word->name, wordname, namelen);
new_word->name[namelen] = 0;
new_word->flags = WORDFLAG_BUILTIN | WORDFLAG_DEFER;
fh->dict_last = ptr;
return FH_OK;
}
static enum fh_error w_defer_store(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t xt1, xt2;
TRY(ds_pop(fh, &xt1));
TRY(ds_pop(fh, &xt2));
struct fh_word_s *ww = fh_word_at(fh, xt1);
if (0 == (ww->flags & WORDFLAG_DEFER)) {
LOGE("%s is not DEFER!", ww->name);
return FH_ERR_BAD_DEFER;
}
ww->param = xt2;
return FH_OK;
}
static enum fh_error w_defer_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t xt1;
TRY(ds_pop(fh, &xt1));
struct fh_word_s *ww = fh_word_at(fh, xt1);
if (0 == (ww->flags & WORDFLAG_DEFER)) {
LOGE("%s is not DEFER!", ww->name);
return FH_ERR_BAD_DEFER;
}
TRY(ds_push(fh, ww->param));
return FH_OK;
}
static enum fh_error w_is(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
char *wordname;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
uint32_t addr;
if (FH_OK != fh_find_word(fh, wordname, namelen, &addr)) {
LOGE("' %.*s word not found!", (int) namelen, wordname);
return FH_ERR_UNKNOWN_WORD;
}
struct fh_word_s *ww = fh_word_at(fh, addr);
if (0 == (ww->flags & WORDFLAG_DEFER)) {
LOGE("%s is not DEFER!", ww->name);
return FH_ERR_BAD_DEFER;
}
if (fh->state == FH_STATE_COMPILE) {
TRY(fh_put_instr(fh, FH_INSTR_ISDEFER, addr));
} else {
TRY(ds_pop(fh, &ww->param));
}
return FH_OK;
}
static enum fh_error w_action_of(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
char *wordname;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
uint32_t addr;
if (FH_OK != fh_find_word(fh, wordname, namelen, &addr)) {
LOGE("' %.*s word not found!", (int) namelen, wordname);
return FH_ERR_UNKNOWN_WORD;
}
struct fh_word_s *ww = fh_word_at(fh, addr);
if (0 == (ww->flags & WORDFLAG_DEFER)) {
LOGE("%s is not DEFER!", ww->name);
return FH_ERR_BAD_DEFER;
}
if (fh->state == FH_STATE_COMPILE) {
TRY(fh_put_instr(fh, FH_INSTR_ACTIONOF, addr));
} else {
TRY(ds_push(fh, ww->param));
}
return FH_OK;
}
static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w) static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w)
{ {
(void) w; (void) w;
@ -796,6 +936,11 @@ const struct name_and_handler fh_builtins_meta[] = {
{"parse-name", w_parse_name, 0, 0}, {"parse-name", w_parse_name, 0, 0},
{"count", w_count, 0, 0}, {"count", w_count, 0, 0},
{"create", w_create, 0, 0}, {"create", w_create, 0, 0},
{"defer", w_defer, 0, 0},
{"defer!", w_defer_store, 0, 0},
{"defer@", w_defer_fetch, 0, 0},
{"action-of", w_action_of, 1, 0}, // imm because it has special compile behavior
{"is", w_is, 1, 0},
{"find", w_find, 0, 0}, {"find", w_find, 0, 0},
{"'", wp_tick, 1, 0}, {"'", wp_tick, 1, 0},
{"[']", wp_tick, 1, 1}, {"[']", wp_tick, 1, 1},

@ -255,12 +255,6 @@ static enum fh_error w_c_quote(struct fh_thread_s *fh, const struct fh_word_s *w
return FH_OK; return FH_OK;
} }
static bool chartest_equals_or_end(char c, void *param)
{
char cc = *(char *) param;
return cc == c || c == 0;
}
static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w) static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
{ {
(void) w; (void) w;
@ -282,7 +276,7 @@ static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s
TRY(fh_input_read_quotedstring(fh, 1, start, capacity, &len)); TRY(fh_input_read_quotedstring(fh, 1, start, capacity, &len));
} else { } else {
start = NULL; start = NULL;
TRY(fh_input_read_delimited(fh, &start, &len, chartest_equals_or_end, &c)); TRY(fh_input_read_delimited(fh, &start, &len, fh_chartest_equals_or_end, &c));
if (len > capacity) { if (len > capacity) {
LOGE("String too low for heap"); LOGE("String too low for heap");
return FH_ERR_HEAP_FULL; return FH_ERR_HEAP_FULL;

@ -22,6 +22,7 @@ static const char *errornames[FH_ERR_MAX] = {
[FH_ERR_SYNTAX] = "SYNTAX_ERROR", [FH_ERR_SYNTAX] = "SYNTAX_ERROR",
[FH_ERR_PICTNUM_FULL] = "PICTNUM_FULL", [FH_ERR_PICTNUM_FULL] = "PICTNUM_FULL",
[FH_ERR_NOT_APPLICABLE] = "NOT_APPLICABLE", [FH_ERR_NOT_APPLICABLE] = "NOT_APPLICABLE",
[FH_ERR_BAD_DEFER] = "BAD_DEFER",
}; };
/** Get error name from code, returns Unknown if not defined */ /** Get error name from code, returns Unknown if not defined */

@ -119,15 +119,21 @@ enum fh_error fh_input_read_delimited(struct fh_thread_s *fh, char **out, size_t
return FH_OK; return FH_OK;
} }
static bool chartest_space_or_end(char c, void *param) bool fh_chartest_space_or_end(char c, void *param)
{ {
(void) param; (void) param;
return isspace(c) || c == 0; return isspace(c) || c == 0;
} }
bool fh_chartest_equals_or_end(char c, void *param)
{
char cc = *(char *) param;
return cc == c || c == 0;
}
enum fh_error fh_input_read_word(struct fh_thread_s *fh, char **out, size_t *len) enum fh_error fh_input_read_word(struct fh_thread_s *fh, char **out, size_t *len)
{ {
return fh_input_read_delimited(fh, out, len, chartest_space_or_end, NULL); return fh_input_read_delimited(fh, out, len, fh_chartest_space_or_end, NULL);
} }
enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, char *outbuf, size_t capacity, size_t *out_len) enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, char *outbuf, size_t capacity, size_t *out_len)
@ -273,23 +279,17 @@ enum fh_error fh_runtime_start(struct fh_thread_s *fh, struct fh_input_spec_s *i
if (fh_globals.interactive || fh_globals.echo) { if (fh_globals.interactive || fh_globals.echo) {
FHPRINT_SVC(" ok\n"); FHPRINT_SVC(" ok\n");
} }
if (fh->state == FH_STATE_SHUTDOWN) {
return 1;
}
} else { } else {
LOGE("ERROR %s on line %d", fherr_name(rv), fh->input->linenum); LOGE("ERROR %s on line %d", fherr_name(rv), fh->input->linenum);
if (!fh_globals.interactive) { if (fh_globals.interactive || fh_globals.rescue) {
if (fh_globals.rescue) { fh_drop_to_interactive(fh);
fh_globals.interactive = 1;
fh_input_teardown(fh);
fh_push_input(fh, fh_create_input_from_filestruct(stdin, NULL));
} else { } else {
return 1; return 1;
} }
} }
/* reset state */
fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
// reset stack pointers
fh->data_stack_top = 0;
fh->return_stack_top = 0;
}
if (fh_globals.interactive) { if (fh_globals.interactive) {
FHPRINT("%s", FH_PROMPT_STR); FHPRINT("%s", FH_PROMPT_STR);

@ -43,8 +43,33 @@ static const char *instrnames[FH_INSTR_MAX] = {
[FH_INSTR_LOOP] = "LOOP", [FH_INSTR_LOOP] = "LOOP",
[FH_INSTR_LOOP_PLUS] = "LOOP_PLUS", [FH_INSTR_LOOP_PLUS] = "LOOP_PLUS",
[FH_INSTR_POSTPONED_WORD] = "POSTPONED_WORD", [FH_INSTR_POSTPONED_WORD] = "POSTPONED_WORD",
[FH_INSTR_ABORTSTR] = "ABORTSTR",
[FH_INSTR_ACTIONOF] = "ACTIONOF",
[FH_INSTR_ISDEFER] = "ISDEFER",
}; };
void fh_abort(struct fh_thread_s *fh) {
fh->data_stack_top = 0;
fh_quit(fh);
}
void fh_drop_to_interactive(struct fh_thread_s *fh) {
fh_input_teardown(fh);
fh_push_input(fh, fh_create_input_from_filestruct(stdin, NULL));
fh->return_stack_top = 0;
fh->execptr = MAGICADDR_EXEC_INTERACTIVE;
fh_globals.interactive = 1;
fh_setstate(fh, FH_STATE_INTERPRET, 0);
}
void fh_quit(struct fh_thread_s *fh) {
if (fh_globals.interactive) {
fh_drop_to_interactive(fh);
fh_setstate(fh, FH_STATE_QUIT, 0);
} else {
fh_setstate(fh, FH_STATE_SHUTDOWN, 0);
}
}
const char *instr_name(enum fh_instruction_kind kind) const char *instr_name(enum fh_instruction_kind kind)
{ {
@ -125,7 +150,11 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
} }
instr:; instr:;
if (fh->state == FH_STATE_SHUTDOWN) {
return FH_OK;
}
if (fh->state == FH_STATE_QUIT) { if (fh->state == FH_STATE_QUIT) {
LOG("QUIT word exec");
/* abort or quit was called, return to interactive mode */ /* abort or quit was called, return to interactive mode */
fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE); fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
return FH_OK; return FH_OK;
@ -366,6 +395,19 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
fh->execptr += strl; fh->execptr += strl;
goto instr; goto instr;
case FH_INSTR_ABORTSTR:
strl = instr->data;
TRY(ds_pop(fh, &val));
LOG("\x1b[35mExec: abort-str\x1b[m \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
if (val != 0) {
FHPRINT("%.*s", (int) strl, fh_str_at(fh, fh->execptr));
LOG("ABORTing");
fh_abort(fh);
goto end;
}
fh->execptr += strl;
goto instr;
case FH_INSTR_ENDWORD: case FH_INSTR_ENDWORD:
LOG("\x1b[35mExec: word-end\x1b[m"); LOG("\x1b[35mExec: word-end\x1b[m");
TRY(rs_pop(fh, &fh->execptr)); TRY(rs_pop(fh, &fh->execptr));
@ -375,6 +417,18 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
} }
goto instr; goto instr;
case FH_INSTR_ACTIONOF:
LOG("\x1b[35mExec: actionof\x1b[m");
w2 = fh_word_at(fh, instr->data);
TRY(ds_push(fh, w2->param));
goto instr;
case FH_INSTR_ISDEFER:
LOG("\x1b[35mExec: isdefer\x1b[m");
w2 = fh_word_at(fh, instr->data);
TRY(ds_pop(fh, &w2->param));
goto instr;
default: default:
LOGE("Run handler not implemented for instr opcode %d", instr->kind); LOGE("Run handler not implemented for instr opcode %d", instr->kind);
} }

@ -82,6 +82,14 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
FHPRINT("Jump(dest 0x%08x)\n", instr->data); FHPRINT("Jump(dest 0x%08x)\n", instr->data);
break; break;
case FH_INSTR_ACTIONOF:
FHPRINT("ActionOf(word 0x%08x)\n", instr->data);
break;
case FH_INSTR_ISDEFER:
FHPRINT("IsDefer(word 0x%08x)\n", instr->data);
break;
case FH_INSTR_DO: case FH_INSTR_DO:
FHPRINT("DO\n"); FHPRINT("DO\n");
break; break;
@ -111,6 +119,12 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
execptr += strl; execptr += strl;
break; break;
case FH_INSTR_ABORTSTR:
strl = instr->data;
FHPRINT("AbortStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr));
execptr += strl;
break;
case FH_INSTR_ALLOCSTR_C: case FH_INSTR_ALLOCSTR_C:
strl = instr->data; strl = instr->data;
FHPRINT("AllocStrC(%d, \"%.*s\")\n", fh->heap[execptr], fh->heap[execptr], fh_str_at(fh, execptr + 1)); FHPRINT("AllocStrC(%d, \"%.*s\")\n", fh->heap[execptr], fh->heap[execptr], fh_str_at(fh, execptr + 1));
@ -139,6 +153,8 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
FHPRINT("Constant %s, value %d (0x%08x)\n", w->name, (int32_t) w->param, w->param); FHPRINT("Constant %s, value %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
} else if (w->flags & WORDFLAG_CREATED) { } else if (w->flags & WORDFLAG_CREATED) {
FHPRINT("CREATE'd entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param); FHPRINT("CREATE'd entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
} else if (w->flags & WORDFLAG_DEFER) {
FHPRINT("DEFER'd entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
} else { } else {
FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param); FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
} }

@ -82,6 +82,8 @@ int main(int argc, char *argv[])
(int) fh.data_stack_hwm, (int) fh.return_stack_hwm, (int) fh.data_stack_hwm, (int) fh.return_stack_hwm,
(int) fh.here); (int) fh.here);
if (fh_globals.interactive) {
FHPRINT_SVC("Bye.\n"); FHPRINT_SVC("Bye.\n");
}
return 0; return 0;
} }

@ -0,0 +1,4 @@
: foo abort" Aborting!" ." Did not abort" ;
1 foo
0 foo

@ -1712,6 +1712,7 @@ T{ CHAR " PARSE 4567 "DUP ROT ROT EVALUATE -> 5 4567 }T
TESTING PARSE-NAME (Forth 2012) TESTING PARSE-NAME (Forth 2012)
\ Adapted from the PARSE-NAME RfD tests \ Adapted from the PARSE-NAME RfD tests
\ XXX this was missing from the test suite, added!
: STR1 S" abcd" ; : STR1 S" abcd" ;
: STR2 S" abcde" ; : STR2 S" abcde" ;

Loading…
Cancel
Save