diff --git a/README.md b/README.md index fdb5601..3ea50b5 100644 --- a/README.md +++ b/README.md @@ -49,13 +49,13 @@ Implemented and tested: ``` CORE: ! ' ( * */ */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 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] ] 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: @@ -66,10 +66,10 @@ Missing: ``` CORE: -ABORT ABORT" ACCEPT KEY +ACCEPT KEY CORE-EXT: -ACTION-OF DEFER DEFER! DEFER@ IS REFILL SOURCE-ID [COMPILE] +REFILL SOURCE-ID [COMPILE] ``` . diff --git a/include/fh_builtins.h b/include/fh_builtins.h index c883e05..4e8fcc0 100644 --- a/include/fh_builtins.h +++ b/include/fh_builtins.h @@ -22,7 +22,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh); #define ENSURE_STATE(__state) do { \ 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; \ } \ } while (0) diff --git a/include/fh_error.h b/include/fh_error.h index e4f8263..535991d 100644 --- a/include/fh_error.h +++ b/include/fh_error.h @@ -29,6 +29,7 @@ enum fh_error { FH_ERR_SYNTAX, FH_ERR_NOT_APPLICABLE, FH_ERR_PICTNUM_FULL, + FH_ERR_BAD_DEFER, FH_ERR_MAX, }; diff --git a/include/fh_parse.h b/include/fh_parse.h index aada5f9..8efc088 100644 --- a/include/fh_parse.h +++ b/include/fh_parse.h @@ -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); +// 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 diff --git a/include/fh_runtime.h b/include/fh_runtime.h index 31e7a2c..ec3ba6e 100644 --- a/include/fh_runtime.h +++ b/include/fh_runtime.h @@ -43,6 +43,9 @@ enum fh_instruction_kind { /** This is the `."` instruction, same format as above. */ FH_INSTR_TYPESTR, + /** abort" in compiled form */ + FH_INSTR_ABORTSTR, + /* Unconditional jump */ FH_INSTR_JUMP, @@ -76,12 +79,22 @@ enum fh_instruction_kind { /* Postponed word */ FH_INSTR_POSTPONED_WORD, + + /* Action-of in compiled form */ + FH_INSTR_ACTIONOF, + + /* IS in compiled form */ + FH_INSTR_ISDEFER, FH_INSTR_MAX, }; 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 */ struct fh_instruction_s { /** What is the meaning of data? */ @@ -133,6 +146,8 @@ extern const char *substatenames[FH_SUBSTATE_MAX]; #define WORDFLAG_CREATED 0x20 /** Word marked as hidden is not findable, e.g. because it is being compiled. */ #define WORDFLAG_HIDDEN 0x40 +/** Created using DEFER */ +#define WORDFLAG_DEFER 0x80 /** Word struct as they are stored in the dictionary */ struct fh_word_s { diff --git a/src/fh_builtins_control.c b/src/fh_builtins_control.c index bbc3203..dc7b933 100644 --- a/src/fh_builtins_control.c +++ b/src/fh_builtins_control.c @@ -244,6 +244,67 @@ static enum fh_error w_of(struct fh_thread_s *fh, const struct fh_word_s *w) 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) { (void) w; @@ -310,6 +371,9 @@ const struct name_and_handler fh_builtins_control[] = { {"else", w_else, 1, 0}, {"then", w_then, 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, 1}, {"loop", wp_loop, 1, 0}, diff --git a/src/fh_builtins_meta.c b/src/fh_builtins_meta.c index b1bef6f..7c551b2 100644 --- a/src/fh_builtins_meta.c +++ b/src/fh_builtins_meta.c @@ -38,6 +38,17 @@ static enum fh_error rt_marker(struct fh_thread_s *fh, const struct fh_word_s *w 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) { (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; } +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) { (void) w; @@ -796,6 +936,11 @@ const struct name_and_handler fh_builtins_meta[] = { {"parse-name", w_parse_name, 0, 0}, {"count", w_count, 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}, {"'", wp_tick, 1, 0}, {"[']", wp_tick, 1, 1}, diff --git a/src/fh_builtins_text.c b/src/fh_builtins_text.c index 94bbe00..fa5c2f2 100644 --- a/src/fh_builtins_text.c +++ b/src/fh_builtins_text.c @@ -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; } -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) { (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)); } else { 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) { LOGE("String too low for heap"); return FH_ERR_HEAP_FULL; diff --git a/src/fh_error.c b/src/fh_error.c index 942620c..332a833 100644 --- a/src/fh_error.c +++ b/src/fh_error.c @@ -22,6 +22,7 @@ static const char *errornames[FH_ERR_MAX] = { [FH_ERR_SYNTAX] = "SYNTAX_ERROR", [FH_ERR_PICTNUM_FULL] = "PICTNUM_FULL", [FH_ERR_NOT_APPLICABLE] = "NOT_APPLICABLE", + [FH_ERR_BAD_DEFER] = "BAD_DEFER", }; /** Get error name from code, returns Unknown if not defined */ diff --git a/src/fh_parse.c b/src/fh_parse.c index b4902dd..9536a80 100644 --- a/src/fh_parse.c +++ b/src/fh_parse.c @@ -119,15 +119,21 @@ enum fh_error fh_input_read_delimited(struct fh_thread_s *fh, char **out, size_t 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; 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) { - 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) @@ -273,22 +279,16 @@ enum fh_error fh_runtime_start(struct fh_thread_s *fh, struct fh_input_spec_s *i if (fh_globals.interactive || fh_globals.echo) { FHPRINT_SVC(" ok\n"); } + if (fh->state == FH_STATE_SHUTDOWN) { + return 1; + } } else { LOGE("ERROR %s on line %d", fherr_name(rv), fh->input->linenum); - if (!fh_globals.interactive) { - if (fh_globals.rescue) { - fh_globals.interactive = 1; - fh_input_teardown(fh); - fh_push_input(fh, fh_create_input_from_filestruct(stdin, NULL)); - } else { - return 1; - } + if (fh_globals.interactive || fh_globals.rescue) { + fh_drop_to_interactive(fh); + } else { + 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) { diff --git a/src/fh_runtime.c b/src/fh_runtime.c index 131dcc9..7c273bd 100644 --- a/src/fh_runtime.c +++ b/src/fh_runtime.c @@ -43,8 +43,33 @@ static const char *instrnames[FH_INSTR_MAX] = { [FH_INSTR_LOOP] = "LOOP", [FH_INSTR_LOOP_PLUS] = "LOOP_PLUS", [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) { @@ -125,7 +150,11 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) } instr:; + if (fh->state == FH_STATE_SHUTDOWN) { + return FH_OK; + } if (fh->state == FH_STATE_QUIT) { + LOG("QUIT word exec"); /* abort or quit was called, return to interactive mode */ fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE); 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; 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: LOG("\x1b[35mExec: word-end\x1b[m"); TRY(rs_pop(fh, &fh->execptr)); @@ -374,6 +416,18 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) goto end; } 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: LOGE("Run handler not implemented for instr opcode %d", instr->kind); diff --git a/src/fh_see.c b/src/fh_see.c index 30c4bb5..9e6b474 100644 --- a/src/fh_see.c +++ b/src/fh_see.c @@ -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); 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: FHPRINT("DO\n"); break; @@ -111,6 +119,12 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w) execptr += strl; 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: strl = instr->data; 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); } else if (w->flags & WORDFLAG_CREATED) { 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 { FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param); } diff --git a/src/main.c b/src/main.c index 9aa4fb1..9ad17f9 100644 --- a/src/main.c +++ b/src/main.c @@ -82,6 +82,8 @@ int main(int argc, char *argv[]) (int) fh.data_stack_hwm, (int) fh.return_stack_hwm, (int) fh.here); - FHPRINT_SVC("Bye.\n"); + if (fh_globals.interactive) { + FHPRINT_SVC("Bye.\n"); + } return 0; } diff --git a/testfiles/abort.f b/testfiles/abort.f new file mode 100644 index 0000000..5c9e543 --- /dev/null +++ b/testfiles/abort.f @@ -0,0 +1,4 @@ +: foo abort" Aborting!" ." Did not abort" ; + +1 foo +0 foo diff --git a/testfiles/combinedtest.f b/testfiles/combinedtest.f index ea93358..a134c12 100644 --- a/testfiles/combinedtest.f +++ b/testfiles/combinedtest.f @@ -1712,6 +1712,7 @@ T{ CHAR " PARSE 4567 "DUP ROT ROT EVALUATE -> 5 4567 }T TESTING PARSE-NAME (Forth 2012) \ Adapted from the PARSE-NAME RfD tests +\ XXX this was missing from the test suite, added! : STR1 S" abcd" ; : STR2 S" abcde" ;