From 37a1582801866bd6bf5ed383742304913a2adaa9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20Hru=C5=A1ka?= Date: Sun, 21 Nov 2021 12:51:06 +0100 Subject: [PATCH] implement >NUMBER, <# #> fixes --- src/fh_builtins_meta.c | 2 + src/fh_builtins_text.c | 105 +++++++++++++++++++++++++++++++---------- src/fh_runtime.c | 26 ++++++---- 3 files changed, 99 insertions(+), 34 deletions(-) diff --git a/src/fh_builtins_meta.c b/src/fh_builtins_meta.c index 50ba874..01feda4 100644 --- a/src/fh_builtins_meta.c +++ b/src/fh_builtins_meta.c @@ -410,6 +410,8 @@ static enum fh_error w_word(struct fh_thread_s *fh, const struct fh_word_s *w) fh_store_char(fh, WORDBUF_ADDR, (char) len); fh_heap_copyptr(fh, WORDBUF_ADDR + 1, out, len); + + LOG("Word found: \"%.*s\"", len, out); TRY(ds_push(fh, WORDBUF_ADDR)); return FH_OK; diff --git a/src/fh_builtins_text.c b/src/fh_builtins_text.c index c08d0a8..0840115 100644 --- a/src/fh_builtins_text.c +++ b/src/fh_builtins_text.c @@ -1,5 +1,26 @@ #include "forth_internal.h" +static enum fh_error pop_addr_len(struct fh_thread_s *fh, uint32_t *addr, uint32_t *len) +{ + enum fh_error rv; + TRY(ds_pop(fh, len)); + TRY(ds_pop(fh, addr)); + + if (*addr >= HEAP_SIZE) { // not HEAP_END, because this can point into other buffers too + LOGE("heap string pointer out of bounds!"); + return FH_ERR_NOT_APPLICABLE; // TODO better code + } + return FH_OK; +} + +static enum fh_error push_addr_len(struct fh_thread_s *fh, uint32_t addr, uint32_t len) +{ + enum fh_error rv; + TRY(ds_push(fh, addr)); + TRY(ds_push(fh, len)); + return FH_OK; +} + /** * Encode a code point using UTF-8 * @@ -76,15 +97,9 @@ static enum fh_error w_type(struct fh_thread_s *fh, const struct fh_word_s *w) (void) w; enum fh_error rv; uint32_t count = 0, addr = 0; - LOG("Get count,addr"); - TRY(ds_pop(fh, &count)); - TRY(ds_pop(fh, &addr)); - + TRY(pop_addr_len(fh, &addr, &count)); const char *str = fh_str_at(fh, addr); - if (!str) { - LOGE("Type addr out of bounds!"); - return FH_ERR_NOT_APPLICABLE; - } + if (!str) return FH_ERR_INTERNAL; FHPRINT("%.*s", count, str); return FH_OK; } @@ -156,8 +171,7 @@ static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w struct fh_instruction_s instr; if (fh->state == FH_STATE_INTERPRET) { LOG("Interpret a string alloc: \"%.*s\"", len, start); - TRY(ds_push(fh, addr)); - TRY(ds_push(fh, len)); + TRY(push_addr_len(fh, addr, len)); } else { LOG("Compile a string: \"%.*s\"", len, start); instr.kind = FH_INSTR_ALLOCSTR; @@ -238,9 +252,8 @@ static enum fh_error w_hash_greater(struct fh_thread_s *fh, const struct fh_word uint32_t addr; TRY(fh_heap_reserve(fh, len, &addr)); fh_heap_copy(fh, addr, fh->pictnumptr+1, len); - LOG("#> output: \"%.*s\"", len, &fh->heap[fh->pictnumptr+1]); - TRY(ds_push(fh, addr)); - TRY(ds_push(fh, len)); + LOG("#> output: \"%.*s\"", len, &fh->heap[fh->pictnumptr+1]); + TRY(push_addr_len(fh, addr, len)); return FH_OK; } @@ -327,23 +340,64 @@ static enum fh_error w_holds(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; - uint32_t ch; - uint32_t count = 0, addr = 0; - LOG("Get count,addr"); - TRY(ds_pop(fh, &count)); - TRY(ds_pop(fh, &addr)); - + TRY(pop_addr_len(fh, &addr, &count)); const char *str = fh_str_at(fh, addr); - if (!str) { - LOGE("HOLDS addr out of bounds!"); - return FH_ERR_NOT_APPLICABLE; - } + if (!str) return FH_ERR_INTERNAL; - for(int i=count-1;i>=0;i--) { + for(int i=count-1; i>=0; i--) { TRY(pictnum_prepend_char(fh, str[i])); - } + } + + return FH_OK; +} + +static enum fh_error w_to_number(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + + /* + ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) + ud2 is the unsigned result of converting the characters within the string specified by c-addr1 u1 into digits, using the number in BASE, and adding each into ud1 after multiplying ud1 by the number in BASE. Conversion continues left-to-right until a character that is not convertible, including any "+" or "-", is encountered or the string is entirely converted. c-addr2 is the location of the first unconverted character or the first character past the end of the string if the string was entirely converted. u2 is the number of unconverted characters in the string. An ambiguous condition exists if ud2 overflows during the conversion. + */ + + uint32_t count = 0, addr = 0; + TRY(pop_addr_len(fh, &addr, &count)); + const char *str = fh_str_at(fh, addr); + if (!str) return FH_ERR_INTERNAL; + + LOG("parse num from str: %.*s", count, str); + + uint64_t val; + TRY(ds_pop_dw(fh, &val)); + + int conv; + int i = 0; + for(; i= '0' && ch <= '9') { + conv = ch - '0'; + } else if (ch >= 'a' && ch <= 'z') { + conv = 10 + ch - 'a'; + } else if (ch >= 'A' && ch <= 'Z') { + conv = 10 + ch - 'A'; + } else { + break; + } + + if (conv >= fh->base) { + LOG("not numeric, end num parse!"); + break; + } + + val = (val * (uint64_t)fh->base) + (uint64_t)conv; + } + LOG("parsed num: %d", val); + TRY(ds_push_dw(fh, val)); + TRY(push_addr_len(fh, addr+i, count-i)); return FH_OK; } @@ -369,5 +423,6 @@ const struct name_and_handler fh_builtins_text[] = { {"sign", w_sign, 0, 0}, {"hold", w_hold, 0, 0}, {"holds", w_holds, 0, 0}, + {">number", w_to_number, 0, 0}, { /* end marker */ } }; diff --git a/src/fh_runtime.c b/src/fh_runtime.c index 2cc70c2..f49eba7 100644 --- a/src/fh_runtime.c +++ b/src/fh_runtime.c @@ -113,7 +113,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) call: if (!w) { return FH_ERR_INTERNAL; } - LOG("Run user word: %s", w->name); + LOG("\x1b[35mExec: Called user word: %s\x1b[m", w->name); TRY(rs_push(fh, fh->execptr)); fh->execptr = w->param; @@ -167,7 +167,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) // TRY(rs_pop(fh, &fh->execptr)); // } } else { - LOG("Add postponed word: %s", w2->name); + LOG("\x1b[35mExec: Add postponed word\x1b[m %s", w2->name); TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data)); } /*} else { @@ -184,7 +184,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) } call_w2: if (w2->flags & WORDFLAG_BUILTIN) { - LOG("Exec: native-word \"%s\"", w2->name); + LOG("\x1b[35mExec: native-word \"%s\"\x1b[m", w2->name); TRY(w2->handler(fh, w2)); if (fh->substate == FH_SUBSTATE_EXIT) { fh_setsubstate(fh, 0); @@ -196,7 +196,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) } goto instr; } else { - LOG("Exec: user-word %s (CALL)", w2->name); + LOG("\x1b[35mExec: user-word %s\x1b[m (CALL)", w2->name); w = fh_word_at(fh, instr->data); if (!w) { LOGE("CALL instr bad word addr!"); @@ -206,6 +206,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) } case FH_INSTR_JUMPZERO: + LOG("\x1b[35mExec: jump if zero -> 0x%08x\x1b[m", instr->data); if (instr->data == MAGICADDR_UNRESOLVED) { LOGE("Encountered unresolved jump!"); goto end; @@ -213,11 +214,15 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) TRY(ds_pop(fh, &val)); if (0 == val) { + LOG("Jumping"); fh->execptr = instr->data; + } else { + LOG("No jump"); } goto instr; case FH_INSTR_JUMP: + LOG("\x1b[35mExec: jump -> 0x%08x\x1b[m", instr->data); if (instr->data == MAGICADDR_UNRESOLVED) { LOGE("Encountered unresolved jump!"); goto end; @@ -232,7 +237,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) LOGE("TO instr bad variable addr!"); return FH_ERR_INTERNAL; } - LOG("Exec: %d->%s", val, w2->name); + LOG("\x1b[35mExec: %d TO %s\x1b[m", val, w2->name); if (w2->flags & WORDFLAG_CONSTANT) { LOGE("Cannot assign to constant!"); @@ -243,6 +248,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) goto instr; case FH_INSTR_DO: + LOG("\x1b[35mExec: do\x1b[m"); TRY(ds_pop(fh, &index)); TRY(ds_pop(fh, &limit)); // just make sure it exists TRY(fh_loop_nest(fh, index)); @@ -250,6 +256,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) goto instr; case FH_INSTR_DO_QUESTION: + LOG("\x1b[35mExec: ?do\x1b[m"); if (instr->data == MAGICADDR_UNRESOLVED) { LOGE("Encountered unresolved jump!"); goto end; @@ -277,7 +284,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) // R: index,limit TRY(rs_peek(fh, &limit)); - LOG("+LOOP, i=%d, step %d, limit %d", fh->loop_i, val, limit); + LOG("\x1b[35mExec: +LOOP\x1b[m, i=%d, step %d, limit %d", fh->loop_i, val, limit); const int32_t vi = (int32_t)val; const int32_t bdr = (int32_t)limit - (int32_t)1; @@ -304,6 +311,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) goto instr; case FH_INSTR_LEAVE: + LOG("\x1b[35mExec: leave\x1b[m"); if (instr->data == MAGICADDR_UNRESOLVED) { LOGE("Encountered unresolved jump!"); goto end; @@ -318,18 +326,18 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) case FH_INSTR_TYPESTR: strl = instr->data; if (instr->kind == FH_INSTR_ALLOCSTR) { - LOG("Exec: alloc-str \"%.*s\"", strl, fh_str_at(fh, fh->execptr)); + LOG("\x1b[35mExec: alloc-str\x1b[m \"%.*s\"", strl, fh_str_at(fh, fh->execptr)); TRY(ds_push(fh, fh->execptr)); // give pointer directly into the definition TRY(ds_push(fh, strl)); } else { - LOG("Exec: type-str \"%.*s\"", strl, fh_str_at(fh, fh->execptr)); + LOG("\x1b[35mExec: type-str\x1b[m \"%.*s\"", strl, fh_str_at(fh, fh->execptr)); FHPRINT("%.*s", (int) strl, fh_str_at(fh, fh->execptr)); } fh->execptr += strl; goto instr; case FH_INSTR_ENDWORD: - LOG("Exec: word-end"); + LOG("\x1b[35mExec: word-end\x1b[m"); TRY(rs_pop(fh, &fh->execptr)); if (fh->execptr == MAGICADDR_EXEC_INTERACTIVE) { LOG("Done running compiled word");