diff --git a/include/fh_runtime.h b/include/fh_runtime.h index 57ff60a..18b4527 100644 --- a/include/fh_runtime.h +++ b/include/fh_runtime.h @@ -50,6 +50,9 @@ enum fb_instruction_kind { /* DO loop initializer */ FH_INSTR_DO, + /* value TO var */ + FH_INSTR_TO, + /* ?DO short-circuiting loop */ FH_INSTR_DO_QUESTION, diff --git a/src/fh_builtins_arith.c b/src/fh_builtins_arith.c index 3552c96..df8b43e 100644 --- a/src/fh_builtins_arith.c +++ b/src/fh_builtins_arith.c @@ -100,7 +100,7 @@ static enum fh_error w_zero_greater(struct fh_thread_s *fh, const struct fh_word enum fh_error rv; uint32_t a = 0; TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, TOBOOL(a > 0))); + TRY(ds_push(fh, TOBOOL((int32_t) a > 0))); return FH_OK; } @@ -132,11 +132,34 @@ static enum fh_error w_less(struct fh_thread_s *fh, const struct fh_word_s *w) uint32_t a = 0, b = 0; TRY(ds_pop(fh, &b)); TRY(ds_pop(fh, &a)); - TRY(ds_push(fh, TOBOOL(a < b))); + TRY(ds_push(fh, TOBOOL((int32_t) a < (int32_t) b))); return FH_OK; } static enum fh_error w_greater(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0, b = 0; + TRY(ds_pop(fh, &b)); + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, TOBOOL((int32_t) a > (int32_t) b))); + return FH_OK; +} + + +static enum fh_error w_u_less(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0, b = 0; + TRY(ds_pop(fh, &b)); + TRY(ds_pop(fh, &a)); + TRY(ds_push(fh, TOBOOL(a < b))); + return FH_OK; +} + +static enum fh_error w_u_greater(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; @@ -310,37 +333,39 @@ static enum fh_error w_slash_mod(struct fh_thread_s *fh, const struct fh_word_s const struct name_and_handler fh_builtins_arith[] = { /* Arithmetics */ - {"base", wp_const, 0, MAGICADDR_BASE}, - {"decimal", wp_setbase, 0, 10}, - {"hex", wp_setbase, 0, 16}, - {"false", wp_const, 0, 0}, - {"true", wp_const, 0, 0xFFFFFFFF}, - {"+", w_plus, 0, 0}, - {"-", w_minus, 0, 0}, - {"*", w_star, 0, 0}, - {"*/", w_star_slash, 0, 0}, - {"*/mod", w_star_slash_mod, 0, 0}, - {"or", w_or, 0, 0}, - {"and", w_and, 0, 0}, - {"xor", w_xor, 0, 0}, - {"/", w_slash, 0, 0}, - {"abs", w_abs, 0, 0}, - {"/mod", w_slash_mod, 0, 0}, - {"invert", w_invert, 0, 0}, - {"negate", w_negate, 0, 0}, - {"0<", w_zero_less, 0, 0}, - {"0=", w_zero_equals, 0, 0}, - {"0<>", w_zero_not_equals, 0, 0}, - {"0>", w_zero_greater, 0, 0}, - {"<", w_less, 0, 0}, - {"=", w_equals, 0, 0}, - {"<>", w_not_equals, 0, 0}, - {">", w_greater, 0, 0}, - {"1+", wp_add, 0, 1}, - {"1-", wp_add, 0, -1}, - {"2+", wp_add, 0, 2}, - {"2-", wp_add, 0, -2}, - {"2*", wp_mul, 0, 2}, - {"2/", wp_div, 0, 2}, + {"base", wp_const, 0, MAGICADDR_BASE}, + {"decimal", wp_setbase, 0, 10}, + {"hex", wp_setbase, 0, 16}, + {"false", wp_const, 0, 0}, + {"true", wp_const, 0, 0xFFFFFFFF}, + {"+", w_plus, 0, 0}, + {"-", w_minus, 0, 0}, + {"*", w_star, 0, 0}, + {"*/", w_star_slash, 0, 0}, + {"*/mod", w_star_slash_mod, 0, 0}, + {"or", w_or, 0, 0}, + {"and", w_and, 0, 0}, + {"xor", w_xor, 0, 0}, + {"/", w_slash, 0, 0}, + {"abs", w_abs, 0, 0}, + {"/mod", w_slash_mod, 0, 0}, + {"invert", w_invert, 0, 0}, + {"negate", w_negate, 0, 0}, + {"0<", w_zero_less, 0, 0}, + {"0=", w_zero_equals, 0, 0}, + {"0<>", w_zero_not_equals, 0, 0}, + {"0>", w_zero_greater, 0, 0}, + {"<", w_less, 0, 0}, + {"u<", w_u_less, 0, 0}, + {"=", w_equals, 0, 0}, + {"<>", w_not_equals, 0, 0}, + {">", w_greater, 0, 0}, + {"u>", w_u_greater, 0, 0}, + {"1+", wp_add, 0, 1}, + {"1-", wp_add, 0, -1}, + {"2+", wp_add, 0, 2}, + {"2-", wp_add, 0, -2}, + {"2*", wp_mul, 0, 2}, + {"2/", wp_div, 0, 2}, { /* end marker */ } }; diff --git a/src/fh_builtins_mem.c b/src/fh_builtins_mem.c index 596fd82..5efda50 100644 --- a/src/fh_builtins_mem.c +++ b/src/fh_builtins_mem.c @@ -30,6 +30,21 @@ static enum fh_error w_store(struct fh_thread_s *fh, const struct fh_word_s *w) return FH_OK; } +static enum fh_error w_plus_store(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t addr = 0; + TRY(ds_pop(fh, &addr)); + uint32_t val = 0; + TRY(fh_fetch(fh, addr, &val)); + uint32_t val2 = 0; + TRY(ds_pop(fh, &val)); + + TRY(fh_store(fh, addr, val2 + val)); + return FH_OK; +} + static enum fh_error w_two_store(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; @@ -75,7 +90,14 @@ static enum fh_error w_allot(struct fh_thread_s *fh, const struct fh_word_s *w) enum fh_error rv; uint32_t count = 0; TRY(ds_pop(fh, &count)); - TRY(fh_heap_reserve(fh, count, NULL)); + int32_t ci = (int32_t) count; + + if (ci > 0) { + TRY(fh_heap_reserve(fh, ci, NULL)); + } else { + LOG("Deallot %d", count); + fh->here = WORDALIGNED((uint32_t) (int32_t)fh->here + count); + } return FH_OK; } @@ -117,6 +139,14 @@ static enum fh_error w_pad(struct fh_thread_s *fh, const struct fh_word_s *w) return FH_OK; } +static enum fh_error w_here(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + TRY(ds_push(fh, fh->here)); + return FH_OK; +} + const struct name_and_handler fh_builtins_mem[] = { {"chars", wp_mul, 0, 1}, {"char+", wp_add, 0, 1}, @@ -124,13 +154,14 @@ const struct name_and_handler fh_builtins_mem[] = { {"cell+", wp_add, 0, CELL}, {"@", w_fetch, 0, 0}, {"!", w_store, 0, 0}, + {"+!", w_plus_store, 0, 0}, {"2!", w_two_store, 0, 0}, {"2@", w_two_fetch, 0, 0}, {"aligned", w_aligned, 0, 0}, {"allot", w_allot, 0, 0}, {"align", w_align, 0, 0}, {",", w_comma, 0, 0}, - {"here", wp_const, 0, MAGICADDR_HERE}, + {"here", w_here, 0, 0}, {"pad", w_pad, 0, 0}, { /* end marker */ } diff --git a/src/fh_builtins_meta.c b/src/fh_builtins_meta.c index 23e26a3..d04c05e 100644 --- a/src/fh_builtins_meta.c +++ b/src/fh_builtins_meta.c @@ -71,6 +71,98 @@ static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s * return FH_OK; } +static enum fh_error w_read_value(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + enum fh_error rv; + ENSURE_STATE(FH_STATE_INTERPRET); + TRY(ds_push(fh, w->param)); + return FH_OK; +} + +static enum fh_error w_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + enum fh_error rv; + ENSURE_STATE(FH_STATE_INTERPRET); + + uint32_t addr = (void *) &w->param - (void *) &fh->heap[0]; // this is ugly + TRY(ds_push(fh, addr)); + return FH_OK; +} + +static enum fh_error wp_variable(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; + uint32_t value = 0; + + bool is_value = w->param == 1; + bool is_const = w->param == 2; + + if (is_value || is_const) { + TRY(ds_pop(fh, &value)); + } + + TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); + + struct fh_word_s *new_word = fh_word_at(fh, ptr); + new_word->previous = fh->dict_last; + new_word->param = value; + new_word->handler = (is_value || is_const) ? w_read_value : w_read_varaddr; + strncpy(new_word->name, wordname, namelen); + new_word->name[namelen] = 0; + new_word->flags = (is_const ? WORDFLAG_CONSTANT : WORDFLAG_VARIABLE) | WORDFLAG_BUILTIN; + + fh->dict_last = ptr; + + return FH_OK; +} + +static enum fh_error w_to(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + if (fh->state == FH_STATE_INTERPRET) { + uint32_t value; + TRY(ds_pop(fh, &value)); + + char *wordname; + size_t namelen = 0; + uint32_t waddr; + fh_input_consume_spaces(fh); + TRY(fh_input_read_word(fh, &wordname, &namelen)); + TRY(fh_find_word(fh, wordname, namelen, &waddr)); + + struct fh_word_s *ww = fh_word_at(fh, waddr); + + if (ww->flags & WORDFLAG_CONSTANT) { + LOGE("Cannot assign to constant!"); + return FH_ERR_ILLEGAL_STORE; + } + + ww->param = value; + } else if (fh->state == FH_STATE_COMPILE) { + // immediate + char *wordname; + size_t namelen = 0; + uint32_t waddr; + fh_input_consume_spaces(fh); + TRY(fh_input_read_word(fh, &wordname, &namelen)); + TRY(fh_find_word(fh, wordname, namelen, &waddr)); + + TRY(fh_put_instr(fh, FH_INSTR_TO, waddr)); + } + + return FH_OK; +} + static enum fh_error w_leftbracket(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; @@ -172,6 +264,10 @@ const struct name_and_handler fh_builtins_meta[] = { {"literal", w_literal, 1, 0}, {"char", w_char, 0, 0}, {"[char]", w_char, 1, 0}, + {"to", w_to, 1, 0}, + {"variable", wp_variable, 1, 0}, + {"value", wp_variable, 1, 1}, + {"constant", wp_variable, 1, 2}, { /* end marker */ } }; diff --git a/src/fh_runtime.c b/src/fh_runtime.c index a608308..a1778b0 100644 --- a/src/fh_runtime.c +++ b/src/fh_runtime.c @@ -193,7 +193,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) { enum fh_error rv; const struct fh_word_s *w; - const struct fh_word_s *w2; + struct fh_word_s *w2; w = w0; call: @@ -220,7 +220,6 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) uint32_t addr = 0; uint32_t limit, index, index0; - struct fh_instruction_s instr2; switch (instr->kind) { case FH_INSTR_NUMBER: TRY(ds_push(fh, instr->data)); @@ -282,6 +281,19 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0) fh->execptr = instr->data; goto instr; + case FH_INSTR_TO: + TRY(ds_pop(fh, &val)); + w2 = fh_word_at(fh, instr->data); + LOG("Exec: %d->%s", val, w2->name); + + if (w2->flags & WORDFLAG_CONSTANT) { + LOGE("Cannot assign to constant!"); + return FH_ERR_ILLEGAL_STORE; + } + + w2->param = val; + goto instr; + case FH_INSTR_DO: TRY(ds_pop(fh, &index)); TRY(ds_pop(fh, &limit)); // just make sure it exists @@ -388,7 +400,6 @@ enum fh_error fh_init(struct fh_thread_s *fh) enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr) { - struct fh_instruction_s instr; enum fh_error rv; struct fh_word_s *w = fh_word_at(fh, addr); if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) { diff --git a/src/fh_see.c b/src/fh_see.c index a4389b8..bae41ef 100644 --- a/src/fh_see.c +++ b/src/fh_see.c @@ -38,6 +38,15 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w) } break; + case FH_INSTR_TO: + w2 = fh_word_at(fh, instr->data); + if (w2->name[0]) { + FHPRINT("To(var %s)\n", w2->name); + } else { + FHPRINT("To(var 0x%08x)\n", instr->data); + } + break; + case FH_INSTR_JUMPZERO: FHPRINT("JumpIfZero(dest 0x%08x)\n", instr->data); break; @@ -83,11 +92,13 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w) FHPRINT("Unknown(kind 0x%08x, data 0x%08x)\n", instr->kind, instr->data); } } - } else if (w->flags & WORDFLAG_VARIABLE) { - FHPRINT("Variable %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param); - } else if (w->flags & WORDFLAG_CONSTANT) { - FHPRINT("Constant %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param); - } + } else { + FHPRINT("Built-in word %s\n", w->name); + }; + } else if (w->flags & WORDFLAG_VARIABLE) { + FHPRINT("Variable %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param); + } else if (w->flags & WORDFLAG_CONSTANT) { + FHPRINT("Constant %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param); } }