diff --git a/include/fh_runtime.h b/include/fh_runtime.h index 473064a..6370992 100644 --- a/include/fh_runtime.h +++ b/include/fh_runtime.h @@ -76,6 +76,7 @@ enum fh_substate { FH_SUBSTATE_PARENCOMMENT, FH_SUBSTATE_LINECOMMENT, FH_SUBSTATE_EXIT, + FH_SUBSTATE_SEENAME, FH_SUBSTATE_MAX, }; diff --git a/overwrite.forth b/overwrite.forth new file mode 100644 index 0000000..522b091 --- /dev/null +++ b/overwrite.forth @@ -0,0 +1,6 @@ +: a 1 . ; +a +: call_a a a a ; +call_a +: a 7 . ; +call_a diff --git a/src/fh_builtins.c b/src/fh_builtins.c index e6fc865..4a315ae 100644 --- a/src/fh_builtins.c +++ b/src/fh_builtins.c @@ -10,6 +10,12 @@ #define TOBOOL(a) (a == 0 ? 0 : 0xFFFFFFFF) +#define ENSURE_STATE(__state) do { \ + if (fh->state != (__state)) { \ + return FH_ERR_INVALID_STATE; \ + } \ +} while (0) + /** * Encode a code point using UTF-8 @@ -223,6 +229,28 @@ static enum fh_error w_star_slash(struct fh_thread_s *fh, const struct fh_word_s return FH_OK; } +static enum fh_error w_star_slash_mod(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0, b = 0, c = 0; + TRY(ds_pop(fh, &c)); + TRY(ds_pop(fh, &b)); + TRY(ds_pop(fh, &a)); + + if (c == 0) { + return FH_ERR_DIV_BY_ZERO; + } + + uint64_t product = ((uint64_t) a * (uint64_t) b); + uint64_t v = product / (uint64_t) c; + uint64_t m = product % (uint64_t) c; + + TRY(ds_push(fh, (uint32_t) m)); + TRY(ds_push(fh, (uint32_t) v)); + return FH_OK; +} + static enum fh_error w_slash(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; @@ -262,9 +290,7 @@ static enum fh_error w_slash_mod(struct fh_thread_s *fh, const struct fh_word_s static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; - if (fh->state != FH_STATE_INTERPRET) { - return FH_ERR_INVALID_STATE; - } + ENSURE_STATE(FH_STATE_INTERPRET); fh_setstate(fh, FH_STATE_COMPILE, FH_SUBSTATE_COLONNAME); @@ -276,26 +302,61 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) return FH_OK; } -static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s *w) +static enum fh_error w_redirect(struct fh_thread_s *fh, const struct fh_word_s *w) { - (void) w; + const struct fh_word_s *w2 = &fh->dict[w->param]; + LOG("REDIRECT to %s", w2->name); + return w2->handler(fh, w2); +} + +static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s *w0) +{ + (void) w0; enum fh_error rv; struct fh_instruction_s instr; - if (fh->state != FH_STATE_COMPILE) { - return FH_ERR_INVALID_STATE; - } + ENSURE_STATE(FH_STATE_COMPILE); - instr.kind = FH_INSTR_WORD; - instr.data = CPLWORD_ENDWORD; + instr_init(&instr, FH_INSTR_WORD, CPLWORD_ENDWORD); TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); /* Return to interpret state */ fh_setstate(fh, FH_STATE_INTERPRET, 0); + + struct fh_word_s *new_word = &fh->dict[fh->dict_top]; + + /* Now, check if a word with this name already exists. The new one should be used. */ + struct fh_word_s *old_word = &fh->dict[0]; + while (old_word->handler && old_word != new_word) { + if (0 == strncasecmp(new_word->name, old_word->name, MAX_NAME_LEN)) { + // We can't move the new definition because of RECURSE already using its address. + // Instead, redirect and wipe the old name. + old_word->handler = w_redirect; + old_word->start = new_word->start; + old_word->name[0] = 0; + break; + } + old_word++; + } + fh->dict_top++; return FH_OK; } +static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + struct fh_instruction_s instr; + + ENSURE_STATE(FH_STATE_COMPILE); + + instr_init(&instr, FH_INSTR_WORD, fh->dict_top); + TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); + + return FH_OK; +} + static enum fh_error w_dupe(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; @@ -562,7 +623,7 @@ static enum fh_error w_space(struct fh_thread_s *fh, const struct fh_word_s *w) return FH_OK; } -static enum fh_error w_dump(struct fh_thread_s *fh, const struct fh_word_s *w) +static enum fh_error w_debug_dump(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; (void) fh; @@ -665,6 +726,13 @@ static enum fh_error w_emit(struct fh_thread_s *fh, const struct fh_word_s *w) return FH_OK; } +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); + return FH_OK; +} + static enum fh_error wp_const(struct fh_thread_s *fh, const struct fh_word_s *w) { enum fh_error rv; @@ -680,6 +748,27 @@ static enum fh_error w_depth(struct fh_thread_s *fh, const struct fh_word_s *w) return FH_OK; } +// extension +static enum fh_error w_reset(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + + ENSURE_STATE(FH_STATE_INTERPRET); + + fh->data_stack_top = 0; + fh->return_stack_top = 0; + fh->control_stack_top = 0; + fh->data_stack_hwm = 0; + fh->return_stack_hwm = 0; + fh->control_stack_hwm = 0; + fh->heap_top = 0; + fh->dict_top = 0; + + TRY(ds_push(fh, w->param)); + return FH_OK; +} + static enum fh_error w_fetch(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; @@ -770,7 +859,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) {"-", w_minus, 0, 0}, {"*", w_star, 0, 0}, {"*/", w_star_slash, 0, 0}, - // TODO */mod + {"*/mod", w_star_slash_mod, 0, 0}, {"/", w_slash, 0, 0}, {"/mod", w_slash_mod, 0, 0}, {"0<", w_zero_less, 0, 0}, @@ -807,11 +896,11 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) {"2dup", w_two_dup, 0, 0}, {"2over", w_two_over, 0, 0}, {"2swap", w_two_swap, 0, 0}, -// /* Return stack manip */ + /* Return stack manip */ {">r", w_to_r, 0, 0}, {"r>", w_r_from, 0, 0}, {"r@", w_r_fetch, 0, 0}, -// /* Double wide return stack manip */ + /* 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}, @@ -821,7 +910,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) {"cr", wp_putc, 0, '\n'}, {"space", wp_putc, 0, ' '}, {"bl", wp_const, 0, ' '}, - {"dump", w_dump, 0, 0}, + {"??", w_debug_dump, 0, 0}, {"emit", w_emit, 0, 0}, /* Control flow */ {"abort", w_abort, 0, 0}, @@ -832,6 +921,10 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh) {";", 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}, + { /* end marker */ } }; diff --git a/src/fh_runtime.c b/src/fh_runtime.c index 6e084f9..ecc16cb 100644 --- a/src/fh_runtime.c +++ b/src/fh_runtime.c @@ -28,6 +28,7 @@ static const char *substatenames[FH_SUBSTATE_MAX] = { [FH_SUBSTATE_PARENCOMMENT] = "PARENCOMMENT", [FH_SUBSTATE_LINECOMMENT] = "LINECOMMENT", [FH_SUBSTATE_EXIT] = "EXIT", + [FH_SUBSTATE_SEENAME] = "SEENAME", }; /** Add a word to the dictionary. */ @@ -107,7 +108,6 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) case CPLWORD_ALLOCSTR: case CPLWORD_TYPESTR: strl = *((uint32_t *) &fh->compile[fh->execptr]); - LOG("strl %d", strl); fh->execptr += 4; // advance past the length if (wn == CPLWORD_ALLOCSTR) { TRY(fh_heap_reserve(fh, strl, &addr)); @@ -115,11 +115,11 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) LOG("Exec: alloc-str \"%.*s\"", strl, &fh->heap[addr]); TRY(ds_push(fh, addr)); TRY(ds_push(fh, strl)); - fh->execptr += strl; } else { - FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]); LOG("Exec: type-str \"%.*s\"", strl, &fh->compile[fh->execptr]); + FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]); } + fh->execptr += strl; goto instr; case CPLWORD_ENDWORD: @@ -287,6 +287,85 @@ 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) { + if (w->handler == w_user_word) { + FHPRINT("addr 0x%08x ", w->start); + + uint32_t execptr = w->start; + + instr:; + // make sure it's aligned + execptr = WORDALIGNED(execptr); + const struct fh_instruction_s *instr = (const struct fh_instruction_s *) &fh->compile[execptr]; + execptr += INSTR_SIZE; + + uint32_t strl; + uint32_t wn; + const struct fh_word_s *w2; + switch (instr->kind) { + case FH_INSTR_NUMBER: + FHPRINT("Value(%d) ", instr->data); + goto instr; + + case FH_INSTR_WORD: + wn = instr->data; + switch (wn) { + /* special case for strings stored in compile memory */ + case CPLWORD_ALLOCSTR: + case CPLWORD_TYPESTR: + strl = *((uint32_t *) &fh->compile[execptr]); + execptr += 4; // advance past the length + if (wn == CPLWORD_ALLOCSTR) { + FHPRINT("AllocStr(\"%.*s\") ", strl, &fh->compile[execptr]); + execptr += strl; + } else { + FHPRINT("PrintStr(\"%.*s\") ", strl, &fh->compile[execptr]); + execptr += strl; + } + goto instr; + + case CPLWORD_ENDWORD: + FHPRINT("END"); + return; + + default: + w2 = &fh->dict[instr->data]; + if (w2->name[0]) { + FHPRINT("Call(%s) ", w2->name); + } else { + FHPRINT("Call(0x%08x) ", instr->data); + } + goto instr; + } + } + + } else { + FHPRINT("(builtin)"); + } +} + +/** Decompile a word */ +static enum fh_error fh_see_word( + struct fh_thread_s *fh, + const char *start, + 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++; + } + return FH_ERR_UNKNOWN_WORD; +} + /** True if the character is CR or LF */ static inline bool isnl(char c) { @@ -320,6 +399,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf) switch (fh->substate) { case FH_SUBSTATE_NONE: case FH_SUBSTATE_COLONNAME: + case FH_SUBSTATE_SEENAME: /* try to read a word */ end = strchr(rp, ' '); if (end) { @@ -332,11 +412,14 @@ enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf) /* eval a word */ LOG("Handle \"%.*s\"", (int) length, rp); TRY(fh_handle_word(fh, rp, length)); - } else { + } 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); } if (end) {