more fixes in DOES>, now it's almost correct and extra weird
This commit is contained in:
+77
-3
@@ -31,20 +31,81 @@ 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_does(struct fh_thread_s *fh, const struct fh_word_s *w)
|
||||
static enum fh_error w_colon_noname(struct fh_thread_s *fh, const struct fh_word_s *w)
|
||||
{
|
||||
(void) w;
|
||||
enum fh_error rv;
|
||||
ENSURE_STATE(FH_STATE_INTERPRET);
|
||||
|
||||
LOG("Starting noname compilation");
|
||||
|
||||
fh_setstate(fh, FH_STATE_COMPILE, 0);
|
||||
|
||||
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 = MAGICADDR_DICTFIRST;
|
||||
new_word->param = fh->here;
|
||||
new_word->handler = w_user_word;
|
||||
new_word->name[0] = 0;
|
||||
new_word->flags = WORDFLAG_WORD;
|
||||
|
||||
TRY(ds_push(fh, ptr)); // TODO maybe should do this at semicolon?
|
||||
|
||||
return FH_OK;
|
||||
}
|
||||
|
||||
static enum fh_error w_does(struct fh_thread_s *fh, const struct fh_word_s *w)
|
||||
{
|
||||
(void) w;
|
||||
enum fh_error rv;
|
||||
bool crazy = 0;
|
||||
|
||||
if (fh->executing_compiled) {
|
||||
LOG("DOES> in compiled code. OK but weird");
|
||||
//FIXME make this less shitty
|
||||
|
||||
// FIXME this works correctly, but the test fails, because it assumes
|
||||
// that compiled DOES> just changes some pointer in the dict entry,
|
||||
// whereas we do it by generating helper instructions.
|
||||
|
||||
crazy = 1;
|
||||
goto banana;
|
||||
banana2:
|
||||
|
||||
// We are in :NONAME or : NAME.
|
||||
// This word should be compiled.
|
||||
TRY(fh_put_instr(fh, FH_INSTR_JUMP, fh->execptr + INSTR_SIZE)); // skip two forward
|
||||
// next instr run is the ENDWORD emitted at compile time
|
||||
|
||||
return FH_OK;
|
||||
}
|
||||
|
||||
if (fh->state == FH_STATE_COMPILE) {
|
||||
TRY(fh_put_instr(fh, FH_INSTR_WORD, (void*)w - (void*)&fh->heap[0])); // call the DOES word
|
||||
TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 1));
|
||||
return FH_OK;
|
||||
}
|
||||
|
||||
fh_setstate(fh, FH_STATE_COMPILE, 0);
|
||||
|
||||
banana:
|
||||
struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last);
|
||||
if (!last_word) return FH_ERR_INTERNAL;
|
||||
|
||||
last_word->handler = w_user_word;
|
||||
last_word->param = fh->here;
|
||||
last_word->handler = w_user_word;
|
||||
last_word->param = fh->here; // + CELL; // skip the one cell used to hold data. this is a shitty hack
|
||||
last_word->flags = WORDFLAG_WORD;
|
||||
|
||||
uint32_t dptr = fh->here;
|
||||
//TRY(fh_heap_reserve(fh, CELL, NULL));
|
||||
|
||||
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, dptr)); // put pointer to the reserved cell
|
||||
|
||||
if (crazy) goto banana2;
|
||||
|
||||
return FH_OK;
|
||||
}
|
||||
|
||||
@@ -328,6 +389,17 @@ static enum fh_error w_to_in(struct fh_thread_s *fh, const struct fh_word_s *w)
|
||||
return FH_OK;
|
||||
}
|
||||
|
||||
static enum fh_error w_to_body(struct fh_thread_s *fh, const struct fh_word_s *w)
|
||||
{
|
||||
(void) w;
|
||||
enum fh_error rv;
|
||||
|
||||
uint32_t xt;
|
||||
TRY(ds_pop(fh, &xt)); // xt is now a dict entry (hopefully)
|
||||
TRY(ds_push(fh, xt + DICTWORD_SIZE)); // XXX should it still point here if DOES> was used?
|
||||
return FH_OK;
|
||||
}
|
||||
|
||||
static bool chartest_equals_or_end(char c, void *param)
|
||||
{
|
||||
char cc = (char) *(uint32_t *) param;
|
||||
@@ -567,7 +639,9 @@ const struct name_and_handler fh_builtins_meta[] = {
|
||||
{"depth", w_depth, 0, 0},
|
||||
{"unused", w_unused, 0, 0},
|
||||
{">in", w_to_in, 0, 0},
|
||||
{">body", w_to_body, 0, 0},
|
||||
{":", w_colon, 0, 0},
|
||||
{":noname", w_colon_noname, 0, 0},
|
||||
{"does>", w_does, 1, 0},
|
||||
{";", w_semicolon, 1, 0},
|
||||
{"forget", w_forget, 1, 0},
|
||||
|
||||
@@ -175,6 +175,7 @@ enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len)
|
||||
enum fh_error rv;
|
||||
uint32_t addr = 0;
|
||||
TRY(fh_heap_reserve(fh, len, &addr));
|
||||
LOG("Put %d bytes at 0x%08x", len, addr);
|
||||
fh_heap_write(fh, addr, src, len);
|
||||
return FH_OK;
|
||||
}
|
||||
|
||||
@@ -107,6 +107,8 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
|
||||
const struct fh_word_s *w;
|
||||
struct fh_word_s *w2;
|
||||
|
||||
fh->executing_compiled = 1;
|
||||
|
||||
w = w0;
|
||||
call:
|
||||
if (!w) { return FH_ERR_INTERNAL; }
|
||||
@@ -332,6 +334,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
|
||||
}
|
||||
|
||||
end:
|
||||
fh->executing_compiled = 0;
|
||||
return FH_OK;
|
||||
}
|
||||
|
||||
|
||||
+9
-3
@@ -27,7 +27,7 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
|
||||
const struct fh_word_s *w2;
|
||||
switch (instr->kind) {
|
||||
case FH_INSTR_NUMBER:
|
||||
FHPRINT("Number(%d)\n", instr->data);
|
||||
FHPRINT("Number(%d / 0x%08x)\n", instr->data, instr->data);
|
||||
break;
|
||||
|
||||
case FH_INSTR_WORD:
|
||||
@@ -103,8 +103,13 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
|
||||
break;
|
||||
|
||||
case FH_INSTR_ENDWORD:
|
||||
FHPRINT("END\n");
|
||||
return;
|
||||
if (instr->data == 1) {
|
||||
FHPRINT("END (synthetic for DOES>)\n");
|
||||
break;
|
||||
} else {
|
||||
FHPRINT("END\n");
|
||||
return;
|
||||
}
|
||||
|
||||
default:
|
||||
FHPRINT("Unknown(kind 0x%08x, data 0x%08x)\n", instr->kind, instr->data);
|
||||
@@ -133,6 +138,7 @@ enum fh_error fh_see_word(
|
||||
{
|
||||
enum fh_error rv;
|
||||
uint32_t addr;
|
||||
// TODO allow see with addr to inspect :NONAME defined words
|
||||
TRY(fh_find_word(fh, name, wordlen, &addr));
|
||||
show_word(fh, fh_word_at(fh, addr));
|
||||
return FH_OK;
|
||||
|
||||
Reference in New Issue
Block a user