MightyPork/forth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add variables, fix negative allot not working

Browse Source
This commit is contained in:
MightyPork
2021-11-17 00:59:50 +01:00
parent ef2e6943bd
commit 569536ae86
6 changed files with 221 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
include/fh_runtime.h
+3
View File
@@ -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,
src/fh_builtins_arith.c
+59 -34
View File
@@ -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 */ }
};
src/fh_builtins_mem.c
+33 -2
View File
@@ -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 */ }
src/fh_builtins_meta.c
+96
View File
@@ -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 */ }
};
src/fh_runtime.c
+14 -3
View File
@@ -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)) {
src/fh_see.c
+16 -5
View File
@@ -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);
}
}