|
|
@ -10,7 +10,7 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
size_t namelen = 0; |
|
|
|
size_t namelen = 0; |
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
LOG("Name: %.*s", namelen, wordname); |
|
|
|
LOG("Name: %.*s", (int) namelen, wordname); |
|
|
|
|
|
|
|
|
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0); |
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0); |
|
|
|
|
|
|
|
|
|
|
@ -18,7 +18,7 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->param = fh->here; |
|
|
|
new_word->param = fh->here; |
|
|
|
new_word->handler = w_user_word; |
|
|
|
new_word->handler = w_user_word; |
|
|
@ -48,13 +48,13 @@ static enum fh_error w_marker(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
size_t namelen = 0; |
|
|
|
size_t namelen = 0; |
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
LOG("Marker name: %.*s", namelen, wordname); |
|
|
|
LOG("Marker name: %.*s", (int) namelen, wordname); |
|
|
|
|
|
|
|
|
|
|
|
uint32_t ptr; |
|
|
|
uint32_t ptr; |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->param = fh->dict_last; |
|
|
|
new_word->param = fh->dict_last; |
|
|
|
new_word->handler = rt_marker; |
|
|
|
new_word->handler = rt_marker; |
|
|
@ -81,7 +81,7 @@ static enum fh_error w_colon_noname(struct fh_thread_s *fh, const struct fh_word |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
//new_word->previous = MAGICADDR_DICTFIRST;
|
|
|
|
//new_word->previous = MAGICADDR_DICTFIRST;
|
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->param = fh->here; |
|
|
|
new_word->param = fh->here; |
|
|
@ -103,7 +103,7 @@ static enum fh_error w_does(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
|
|
|
|
|
|
|
|
if (fh->executing_compiled) { |
|
|
|
if (fh->executing_compiled) { |
|
|
|
struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last); |
|
|
|
struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last); |
|
|
|
if (!last_word) return FH_ERR_INTERNAL; |
|
|
|
if (!last_word) { return FH_ERR_INTERNAL; } |
|
|
|
last_word->param = fh->execptr + INSTR_SIZE; |
|
|
|
last_word->param = fh->execptr + INSTR_SIZE; |
|
|
|
last_word->handler = w_user_word; |
|
|
|
last_word->handler = w_user_word; |
|
|
|
last_word->flags = WORDFLAG_WORD | WORDFLAG_CREATED; |
|
|
|
last_word->flags = WORDFLAG_WORD | WORDFLAG_CREATED; |
|
|
@ -119,7 +119,7 @@ static enum fh_error w_does(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0); |
|
|
|
fh_setstate(fh, FH_STATE_COMPILE, 0); |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last); |
|
|
|
struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last); |
|
|
|
if (!last_word) return FH_ERR_INTERNAL; |
|
|
|
if (!last_word) { return FH_ERR_INTERNAL; } |
|
|
|
|
|
|
|
|
|
|
|
last_word->handler = w_user_word; |
|
|
|
last_word->handler = w_user_word; |
|
|
|
last_word->param = fh->here; |
|
|
|
last_word->param = fh->here; |
|
|
@ -138,13 +138,13 @@ static enum fh_error w_forget(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
size_t namelen = 0; |
|
|
|
size_t namelen = 0; |
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
fh_input_consume_spaces(fh); |
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
TRY(fh_input_read_word(fh, &wordname, &namelen)); |
|
|
|
LOG("Name to forget: %.*s", namelen, wordname); |
|
|
|
LOG("Name to forget: %.*s", (int) namelen, wordname); |
|
|
|
|
|
|
|
|
|
|
|
uint32_t addr; |
|
|
|
uint32_t addr; |
|
|
|
TRY(fh_find_word(fh, wordname, namelen, &addr)); |
|
|
|
TRY(fh_find_word(fh, wordname, namelen, &addr)); |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *removedword = fh_word_at(fh, addr); |
|
|
|
struct fh_word_s *removedword = fh_word_at(fh, addr); |
|
|
|
if (!removedword) return FH_ERR_INTERNAL; |
|
|
|
if (!removedword) { return FH_ERR_INTERNAL; } |
|
|
|
fh->dict_last = removedword->previous; |
|
|
|
fh->dict_last = removedword->previous; |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
@ -210,7 +210,7 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->param = value; |
|
|
|
new_word->param = value; |
|
|
|
new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr; |
|
|
|
new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr; |
|
|
@ -247,7 +247,7 @@ static enum fh_error w_to(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
TRY(fh_find_word(fh, wordname, namelen, &waddr)); |
|
|
|
TRY(fh_find_word(fh, wordname, namelen, &waddr)); |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *ww = fh_word_at(fh, waddr); |
|
|
|
struct fh_word_s *ww = fh_word_at(fh, waddr); |
|
|
|
if (!ww) return FH_ERR_INTERNAL; |
|
|
|
if (!ww) { return FH_ERR_INTERNAL; } |
|
|
|
|
|
|
|
|
|
|
|
if (ww->flags & WORDFLAG_WORD) { |
|
|
|
if (ww->flags & WORDFLAG_WORD) { |
|
|
|
LOGE("Cannot assign to dictionary word param field!"); |
|
|
|
LOGE("Cannot assign to dictionary word param field!"); |
|
|
@ -352,15 +352,13 @@ static enum fh_error w_compile_comma(struct fh_thread_s *fh, const struct fh_wor |
|
|
|
static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
{ |
|
|
|
{ |
|
|
|
(void) w; |
|
|
|
(void) w; |
|
|
|
enum fh_error rv; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (fh->dict_last == 0) { |
|
|
|
if (fh->dict_last == 0) { |
|
|
|
LOGE("Dict is empty, cannot modify previous word!"); |
|
|
|
LOGE("Dict is empty, cannot modify previous word!"); |
|
|
|
return FH_ERR_INVALID_STATE; |
|
|
|
return FH_ERR_INVALID_STATE; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *word = fh_word_at(fh, fh->dict_last); |
|
|
|
struct fh_word_s *word = fh_word_at(fh, fh->dict_last); |
|
|
|
if (!word) return FH_ERR_INTERNAL; |
|
|
|
if (!word) { return FH_ERR_INTERNAL; } |
|
|
|
word->flags |= WORDFLAG_IMMEDIATE; |
|
|
|
word->flags |= WORDFLAG_IMMEDIATE; |
|
|
|
|
|
|
|
|
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
@ -432,7 +430,7 @@ static enum fh_error w_to_body(struct fh_thread_s *fh, const struct fh_word_s *w |
|
|
|
|
|
|
|
|
|
|
|
uint32_t xt; |
|
|
|
uint32_t xt; |
|
|
|
TRY(ds_pop(fh, &xt)); // xt is now a dict entry (hopefully)
|
|
|
|
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?
|
|
|
|
TRY(ds_push(fh, xt + DICTWORD_SIZE)); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -467,7 +465,7 @@ 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_store_char(fh, WORDBUF_ADDR, (char) len); |
|
|
|
fh_heap_copyptr(fh, WORDBUF_ADDR + 1, out, len); |
|
|
|
fh_heap_copyptr(fh, WORDBUF_ADDR + 1, out, len); |
|
|
|
|
|
|
|
|
|
|
|
LOG("Word found: \"%.*s\"", len, out); |
|
|
|
LOG("Word found: \"%.*s\"", (int) len, out); |
|
|
|
|
|
|
|
|
|
|
|
TRY(ds_push(fh, WORDBUF_ADDR)); |
|
|
|
TRY(ds_push(fh, WORDBUF_ADDR)); |
|
|
|
return FH_OK; |
|
|
|
return FH_OK; |
|
|
@ -503,7 +501,7 @@ static enum fh_error w_create(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr)); |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
struct fh_word_s *new_word = fh_word_at(fh, ptr); |
|
|
|
if (!new_word) return FH_ERR_INTERNAL; |
|
|
|
if (!new_word) { return FH_ERR_INTERNAL; } |
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->previous = fh->dict_last; |
|
|
|
new_word->param = fh->here; |
|
|
|
new_word->param = fh->here; |
|
|
|
new_word->handler = rt_read_value; |
|
|
|
new_word->handler = rt_read_value; |
|
|
@ -537,7 +535,7 @@ static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w) |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
struct fh_word_s *word = fh_word_at(fh, addr); |
|
|
|
struct fh_word_s *word = fh_word_at(fh, addr); |
|
|
|
if (!word) return FH_ERR_INTERNAL; |
|
|
|
if (!word) { return FH_ERR_INTERNAL; } |
|
|
|
|
|
|
|
|
|
|
|
TRY(ds_push(fh, addr)); |
|
|
|
TRY(ds_push(fh, addr)); |
|
|
|
TRY(ds_push(fh, (word->flags & WORDFLAG_IMMEDIATE) ? 1 : -1)); |
|
|
|
TRY(ds_push(fh, (word->flags & WORDFLAG_IMMEDIATE) ? 1 : -1)); |
|
|
@ -617,56 +615,41 @@ static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s |
|
|
|
if (EQ(str, "/COUNTED-STRING", len)) { |
|
|
|
if (EQ(str, "/COUNTED-STRING", len)) { |
|
|
|
TRY(ds_push(fh, 255)); |
|
|
|
TRY(ds_push(fh, 255)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "/HOLD", len)) { |
|
|
|
else if (EQ(str, "/HOLD", len)) { |
|
|
|
|
|
|
|
TRY(ds_push(fh, WORDBUF_SIZE)); |
|
|
|
TRY(ds_push(fh, WORDBUF_SIZE)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "/PAD", len)) { |
|
|
|
else if (EQ(str, "/PAD", len)) { |
|
|
|
|
|
|
|
TRY(ds_push(fh, MIN_PAD_SIZE)); |
|
|
|
TRY(ds_push(fh, MIN_PAD_SIZE)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "ADDRESS-UNIT-BITS", len)) { |
|
|
|
else if (EQ(str, "ADDRESS-UNIT-BITS", len)) { |
|
|
|
|
|
|
|
TRY(ds_push(fh, 8)); |
|
|
|
TRY(ds_push(fh, 8)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "FLOORED", len)) { |
|
|
|
else if (EQ(str, "FLOORED", len)) { |
|
|
|
TRY(ds_push(fh, TOBOOL(1))); |
|
|
|
TRY(ds_push(fh, TOBOOL(1))); // FIXME is it?
|
|
|
|
|
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "MAX-CHAR", len)) { |
|
|
|
else if (EQ(str, "MAX-CHAR", len)) { |
|
|
|
|
|
|
|
TRY(ds_push(fh, 255)); |
|
|
|
TRY(ds_push(fh, 255)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "MAX-D", len)) { |
|
|
|
else if (EQ(str, "MAX-D", len)) { |
|
|
|
TRY(ds_push_dw(fh, 0x7FFFFFFFFFFFFFFFULL)); |
|
|
|
// TODO update when double arith is properly implemented
|
|
|
|
} else if (EQ(str, "MAX-UD", len)) { |
|
|
|
TRY(ds_push(fh, 0)); |
|
|
|
TRY(ds_push_dw(fh, 0xFFFFFFFFFFFFFFFFULL)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "MAX-N", len)) { |
|
|
|
else if (EQ(str, "MAX-UD", len)) { |
|
|
|
|
|
|
|
// TODO update when double arith is properly implemented
|
|
|
|
|
|
|
|
TRY(ds_push(fh, 0)); |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
else if (EQ(str, "MAX-N", len)) { |
|
|
|
|
|
|
|
TRY(ds_push(fh, 0x7FFFFFFFULL)); |
|
|
|
TRY(ds_push(fh, 0x7FFFFFFFULL)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "MAX-U", len)) { |
|
|
|
else if (EQ(str, "MAX-U", len)) { |
|
|
|
|
|
|
|
TRY(ds_push(fh, 0xFFFFFFFFULL)); |
|
|
|
TRY(ds_push(fh, 0xFFFFFFFFULL)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "RETURN-STACK-CELLS", len)) { |
|
|
|
else if (EQ(str, "RETURN-STACK-CELLS", len)) { |
|
|
|
|
|
|
|
TRY(ds_push(fh, RETURN_STACK_DEPTH)); |
|
|
|
TRY(ds_push(fh, RETURN_STACK_DEPTH)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "STACK-CELLS", len)) { |
|
|
|
else if (EQ(str, "STACK-CELLS", len)) { |
|
|
|
|
|
|
|
TRY(ds_push(fh, DATA_STACK_DEPTH)); |
|
|
|
TRY(ds_push(fh, DATA_STACK_DEPTH)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else if (EQ(str, "CORE", len)) { |
|
|
|
else if (EQ(str, "CORE", len)) { |
|
|
|
|
|
|
|
TRY(ds_push(fh, TOBOOL(1))); |
|
|
|
TRY(ds_push(fh, TOBOOL(1))); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
TRY(ds_push(fh, 1)); |
|
|
|
} |
|
|
|
} else { |
|
|
|
else { |
|
|
|
|
|
|
|
TRY(ds_push(fh, 0)); |
|
|
|
TRY(ds_push(fh, 0)); |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|