#include "forth_internal.h" static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_INTERPRET); char *wordname = NULL; size_t namelen = 0; fh_input_consume_spaces(fh); TRY(fh_input_read_word(fh, &wordname, &namelen)); LOG("Name: %.*s", namelen, wordname); 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 = fh->dict_last; new_word->param = fh->here; new_word->handler = w_user_word; strncpy(new_word->name, wordname, namelen); new_word->name[namelen] = 0; new_word->flags = WORDFLAG_WORD; fh->dict_last = ptr; return FH_OK; } static enum fh_error w_forget(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_INTERPRET); char *wordname = NULL; size_t namelen = 0; fh_input_consume_spaces(fh); TRY(fh_input_read_word(fh, &wordname, &namelen)); LOG("Name to forget: %.*s", namelen, wordname); uint32_t addr; TRY(fh_find_word(fh, wordname, namelen, &addr)); struct fh_word_s *removedword = fh_word_at(fh, addr); if (!removedword) return FH_ERR_INTERNAL; fh->dict_last = removedword->previous; return FH_OK; } static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); char *wordname; size_t namelen = 0; fh_input_consume_spaces(fh); TRY(fh_input_read_word(fh, &wordname, &namelen)); TRY(fh_postpone_word(fh, wordname, namelen)); return FH_OK; } static enum fh_error rt_read_value(struct fh_thread_s *fh, const struct fh_word_s *w) { enum fh_error rv; TRY(ds_push(fh, w->param)); return FH_OK; } static enum fh_error rt_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w) { enum fh_error rv; 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; bool is_value = w->param == 1; bool is_const = w->param == 2; if (is_const && fh->state == FH_STATE_COMPILE) { uint32_t wordaddr = (void *)w - (void *)&fh->heap[0]; // this is ugly TRY(fh_put_instr(fh, FH_INSTR_WORD, wordaddr)); return FH_OK; } 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; 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); if (!new_word) return FH_ERR_INTERNAL; new_word->previous = fh->dict_last; new_word->param = value; new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr; strncpy(new_word->name, wordname, namelen); new_word->name[namelen] = 0; new_word->flags = (is_const ? WORDFLAG_CONSTANT : WORDFLAG_VARIABLE) | WORDFLAG_BUILTIN; if (is_const) { LOG("Create CONSTANT %s = %d (0x%08x)", new_word->name, value, value); } else if (is_value) { LOG("Create VALUE %s = %d (0x%08x)", new_word->name, value, value); } else { LOG("Create VARIABLE %s at 0x%08x", new_word->name, ptr); // param field is the first } 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) return FH_ERR_INTERNAL; if (ww->flags & WORDFLAG_WORD) { LOGE("Cannot assign to dictionary word param field!"); return FH_ERR_NOT_APPLICABLE; } if (ww->flags & WORDFLAG_CONSTANT) { LOGE("Cannot assign to constant!"); return FH_ERR_NOT_APPLICABLE; } 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; ENSURE_STATE(FH_STATE_COMPILE); fh_setstate(fh, FH_STATE_INTERPRET, 0); return FH_OK; } static enum fh_error w_rightbracket(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; ENSURE_STATE(FH_STATE_INTERPRET); fh_setstate(fh, FH_STATE_COMPILE, 0); return FH_OK; } static enum fh_error w_source(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; TRY(ds_push(fh, INPUTBUF_ADDR)); TRY(ds_push(fh, fh->inputlen)); // TRY(ds_push(fh, INPUTBUF_ADDR + fh->inputptr)); // TRY(ds_push(fh, fh->inputlen - fh->inputptr)); return FH_OK; } static enum fh_error w_literal(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); uint32_t val; TRY(ds_pop(fh, &val)); TRY(fh_put_instr(fh, FH_INSTR_NUMBER, val)); return FH_OK; } static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s *w0) { (void) w0; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 0)); /* Return to interpret state */ fh_setstate(fh, FH_STATE_INTERPRET, 0); // XXX if there was another definition previously and it was used in some other compiled function, // that old implementation will still be called. return FH_OK; } static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; if (fh->dict_last == 0) { LOGE("Dict is empty, cannot modify previous word!"); return FH_ERR_INVALID_STATE; } struct fh_word_s *word = fh_word_at(fh, fh->dict_last); if (!word) return FH_ERR_INTERNAL; word->flags |= WORDFLAG_IMMEDIATE; return FH_OK; } static enum fh_error w_backslash(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; fh_setsubstate(fh, FH_SUBSTATE_LINE_COMMENT); return FH_OK; } static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; fh_setsubstate(fh, FH_SUBSTATE_PAREN_COMMENT); return FH_OK; } static enum fh_error wp_char(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; bool bracketed = w->param; if (bracketed) ENSURE_STATE(FH_STATE_COMPILE); char *wordname = NULL; size_t namelen = 0; fh_input_consume_spaces(fh); TRY(fh_input_read_word(fh, &wordname, &namelen)); char c = (char) *wordname; if (bracketed) { TRY(fh_put_instr(fh, FH_INSTR_NUMBER, c)); } else { TRY(ds_push(fh, c)); } return FH_OK; } static enum fh_error w_depth(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; TRY(ds_push(fh, fh->data_stack_top)); return FH_OK; } static enum fh_error w_unused(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; TRY(ds_push(fh, HEAP_SIZE - fh->here)); return FH_OK; } static enum fh_error w_to_in(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; TRY(ds_push(fh, MAGICADDR_INPTR)); return FH_OK; } static bool chartest_equals_or_end(char c, void *param) { char cc = (char) *(uint32_t *) param; return c == cc || c == 0; } static enum fh_error w_word(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; uint32_t ch; TRY(ds_pop(fh, &ch)); if (ch > 0xFF) { LOGE("Char out of ASCII bounds!"); return FH_ERR_NOT_APPLICABLE; } fh_input_consume_matching(fh, chartest_equals_or_end, &ch); char *out; size_t len; fh_input_read_delimited(fh, &out, &len, chartest_equals_or_end, &ch); if (len >= WORDBUF_SIZE) { LOGE("WORD parsed string too long"); return FH_ERR_NAME_TOO_LONG; } fh_store_char(fh, WORDBUF_ADDR, (char) len); fh_heap_copyptr(fh, WORDBUF_ADDR + 1, out, len); TRY(ds_push(fh, WORDBUF_ADDR)); return FH_OK; } static enum fh_error w_count(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; uint32_t caddr; TRY(ds_pop(fh, &caddr)); uint8_t len; TRY(fh_fetch_char(fh, caddr, (char *) &len)); TRY(ds_push(fh, caddr + 1)); TRY(ds_push(fh, len)); return FH_OK; } static enum fh_error w_create(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; 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 = fh->dict_last; new_word->param = fh->here; new_word->handler = rt_read_value; strncpy(new_word->name, wordname, namelen); new_word->name[namelen] = 0; new_word->flags = WORDFLAG_BUILTIN | WORDFLAG_CREATED; fh->dict_last = ptr; return FH_OK; } static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_INTERPRET); uint32_t caddr; TRY(ds_pop(fh, &caddr)); uint8_t len; TRY(fh_fetch_char(fh, caddr, (char *) &len)); uint32_t addr; if (FH_OK != fh_find_word(fh, fh_str_at(fh, caddr + 1), len, &addr)) { /* not found */ TRY(ds_push(fh, caddr)); TRY(ds_push(fh, 0)); return FH_OK; } struct fh_word_s *word = fh_word_at(fh, addr); if (!word) return FH_ERR_INTERNAL; TRY(ds_push(fh, addr)); TRY(ds_push(fh, (word->flags & WORDFLAG_IMMEDIATE) ? 1 : -1)); return FH_OK; } static enum fh_error wp_tick(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; bool bracketed = w->param; if (bracketed) ENSURE_STATE(FH_STATE_COMPILE); char *wordname; size_t namelen = 0; fh_input_consume_spaces(fh); TRY(fh_input_read_word(fh, &wordname, &namelen)); uint32_t addr; if (FH_OK != fh_find_word(fh, wordname, namelen, &addr)) { LOGE("' %.*s word not found!", (int) namelen, wordname); return FH_ERR_UNKNOWN_WORD; } if (bracketed) { TRY(fh_put_instr(fh, FH_INSTR_NUMBER, addr)); } else { TRY(ds_push(fh, addr)); } return FH_OK; } static enum fh_error w_execute(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; uint32_t addr; TRY(ds_pop(fh, &addr)); if (addr != WORDALIGNED(addr)) { LOGE("Invalid execution token, address must be aligned!"); return FH_ERR_ILLEGAL_FETCH; } struct fh_word_s *word = fh_word_at(fh, addr); if (!word) { LOGE("Execute with bad addr"); return FH_ERR_NOT_APPLICABLE; } if (!word->handler) { LOGE("Execute word with no handler"); return FH_ERR_NOT_APPLICABLE; } TRY(word->handler(fh, word)); return FH_OK; } static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; uint32_t len; TRY(ds_pop(fh, &len)); uint32_t addr; TRY(ds_pop(fh, &addr)); const char *str = fh_str_at(fh, addr); if (!str) { LOGE("Bad string addr for env query!"); return FH_ERR_NOT_APPLICABLE; } LOG("Test environment \"%.*s\"", len, str); if (EQ(str, "/COUNTED-STRING", len)) { TRY(ds_push(fh, 255)); TRY(ds_push(fh, 1)); } else if (EQ(str, "/HOLD", len)) { TRY(ds_push(fh, WORDBUF_SIZE)); TRY(ds_push(fh, 1)); } else if (EQ(str, "/PAD", len)) { TRY(ds_push(fh, MIN_PAD_SIZE)); TRY(ds_push(fh, 1)); } else if (EQ(str, "ADDRESS-UNIT-BITS", len)) { TRY(ds_push(fh, 8)); TRY(ds_push(fh, 1)); } else if (EQ(str, "FLOORED", len)) { TRY(ds_push(fh, TOBOOL(1))); // FIXME is it? TRY(ds_push(fh, 1)); } else if (EQ(str, "MAX-CHAR", len)) { TRY(ds_push(fh, 255)); TRY(ds_push(fh, 1)); } else if (EQ(str, "MAX-D", len)) { // TODO update when double arith is properly implemented TRY(ds_push(fh, 0)); } 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, 1)); } else if (EQ(str, "MAX-U", len)) { TRY(ds_push(fh, 0xFFFFFFFFULL)); TRY(ds_push(fh, 1)); } else if (EQ(str, "RETURN-STACK-CELLS", len)) { TRY(ds_push(fh, RETURN_STACK_DEPTH)); TRY(ds_push(fh, 1)); } else if (EQ(str, "STACK-CELLS", len)) { TRY(ds_push(fh, DATA_STACK_DEPTH)); TRY(ds_push(fh, 1)); } else if (EQ(str, "CORE", len)) { TRY(ds_push(fh, TOBOOL(1))); TRY(ds_push(fh, 1)); } else { TRY(ds_push(fh, 0)); } return FH_OK; } const struct name_and_handler fh_builtins_meta[] = { {"depth", w_depth, 0, 0}, {"unused", w_unused, 0, 0}, {">in", w_to_in, 0, 0}, {":", w_colon, 0, 0}, {";", w_semicolon, 1, 0}, {"forget", w_forget, 1, 0}, {"\\", w_backslash, 1, 0}, // line comment {"(", w_paren, 1, 0}, // enclosed comment {"immediate", w_immediate, 0, 0}, {"postpone", w_postpone, 1, 0}, {"[", w_leftbracket, 1, 0}, {"]", w_rightbracket, 1, 0}, {"source", w_source, 0, 0}, {"literal", w_literal, 1, 0}, {"char", wp_char, 0, 0}, {"[char]", wp_char, 1, 1}, {"to", w_to, 1, 0}, {"variable", wp_variable, 1, 0}, {"value", wp_variable, 1, 1}, {"constant", wp_variable, 1, 2}, {"word", w_word, 0, 0}, {"count", w_count, 0, 0}, {"create", w_create, 0, 0}, {"find", w_find, 0, 0}, {"'", wp_tick, 1, 0}, {"[']", wp_tick, 1, 1}, {"execute", w_execute, 0, 0}, {"environment?", w_env_query, 0, 0}, { /* end marker */ } };