#include "forth_internal.h" static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); TRY(fh_put_instr(fh, FH_INSTR_WORD, fh->dict_last)); return FH_OK; } static enum fh_error w_if(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); TRY(cs_push(fh, fh->here)); TRY(fh_put_instr(fh, FH_INSTR_JUMPZERO, MAGICADDR_UNRESOLVED)); return FH_OK; } static enum fh_error w_else(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); uint32_t ifaddr = 0; TRY(cs_pop(fh, &ifaddr)); struct fh_instruction_s *if_instr = fh_instr_at(fh, ifaddr); if (!if_instr || if_instr->data != MAGICADDR_UNRESOLVED) { LOGE("IF-ELSE control stack corruption"); return FH_ERR_INTERNAL; } if_instr->data = fh->here + INSTR_SIZE; TRY(cs_push(fh, fh->here)); TRY(fh_put_instr(fh, FH_INSTR_JUMP, MAGICADDR_UNRESOLVED)); return FH_OK; } static enum fh_error w_then(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); uint32_t ifaddr = 0; TRY(cs_pop(fh, &ifaddr)); struct fh_instruction_s *if_instr = fh_instr_at(fh, ifaddr); if (!if_instr || if_instr->data != MAGICADDR_UNRESOLVED) { LOGE("IF-ELSE control stack corruption"); return FH_ERR_INTERNAL; } if_instr->data = fh->here; return FH_OK; } static enum fh_error w_until(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); uint32_t destaddr = 0; TRY(cs_pop(fh, &destaddr)); TRY(fh_put_instr(fh, FH_INSTR_JUMPZERO, destaddr)); return FH_OK; } static enum fh_error w_begin(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); TRY(cs_push(fh, fh->here)); /* dest */ return FH_OK; } static enum fh_error wp_do(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); TRY(fh_put_instr(fh, w->param ? FH_INSTR_DO_QUESTION : FH_INSTR_DO, MAGICADDR_UNRESOLVED)); // R will now contain: limit,index TRY(cs_push(fh, fh->here)); // mark the start position (after init) return FH_OK; } static enum fh_error wp_loop(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; struct fh_instruction_s *ii; ENSURE_STATE(FH_STATE_COMPILE); uint32_t loopendaddr = fh->here; uint32_t startaddr; TRY(cs_pop(fh, &startaddr)); TRY(fh_put_instr(fh, w->param ? FH_INSTR_LOOP_PLUS : FH_INSTR_LOOP, startaddr)); // after the end LOOP uint32_t endaddr = fh->here; // resolve ?DO dest ii = fh_instr_at(fh, startaddr - INSTR_SIZE); if (!ii || ii->kind == FH_INSTR_DO_QUESTION && ii->data == MAGICADDR_UNRESOLVED) { ii->data = endaddr; } while (startaddr < loopendaddr) { ii = fh_instr_at(fh, startaddr); if (!ii) { LOGE("WHAT?"); return FH_ERR_INTERNAL; } if (ii->kind == FH_INSTR_LEAVE && ii->data == MAGICADDR_UNRESOLVED) { LOG("Resolve leave addr"); ii->data = endaddr; } // forward, skipping strings safely if (ii->kind == FH_INSTR_TYPESTR || ii->kind == FH_INSTR_ALLOCSTR) { startaddr += INSTR_SIZE + ii->data; startaddr = WORDALIGNED(startaddr); } else { startaddr += INSTR_SIZE; } } return FH_OK; } static enum fh_error w_unloop(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; uint32_t limit; TRY(rs_pop(fh, &limit)); TRY(fh_loop_unnest(fh)); return FH_OK; } static enum fh_error w_leave(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); TRY(fh_put_instr(fh, FH_INSTR_LEAVE, MAGICADDR_UNRESOLVED)); return FH_OK; } static enum fh_error w_while(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); uint32_t destaddr = 0; TRY(cs_pop(fh, &destaddr)); TRY(cs_push(fh, fh->here)); // orig TRY(cs_push(fh, destaddr)); // dest TRY(fh_put_instr(fh, FH_INSTR_JUMPZERO, MAGICADDR_UNRESOLVED)); return FH_OK; } static enum fh_error w_repeat(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); uint32_t origaddr = 0; uint32_t destaddr = 0; TRY(cs_pop(fh, &destaddr)); TRY(cs_pop(fh, &origaddr)); struct fh_instruction_s *branch_instr = fh_instr_at(fh, origaddr); if (!branch_instr || branch_instr->data != MAGICADDR_UNRESOLVED) { LOGE("REPEAT control stack corruption"); return FH_ERR_INTERNAL; } branch_instr->data = fh->here + INSTR_SIZE; TRY(fh_put_instr(fh, FH_INSTR_JUMP, destaddr)); return FH_OK; } static enum fh_error w_again(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; enum fh_error rv; ENSURE_STATE(FH_STATE_COMPILE); uint32_t destaddr = 0; TRY(cs_pop(fh, &destaddr)); TRY(fh_put_instr(fh, FH_INSTR_JUMP, destaddr)); return FH_OK; } static enum fh_error wp_ij(struct fh_thread_s *fh, const struct fh_word_s *w) { enum fh_error rv; TRY(ds_push(fh, w->param ? fh->loop_j : fh->loop_i)); return FH_OK; } const struct name_and_handler fh_builtins_control[] = { {"i", wp_ij, 0, 0}, {"j", wp_ij, 0, 1}, {"if", w_if, 1, 0}, {"else", w_else, 1, 0}, {"then", w_then, 1, 0}, {"recurse", w_recurse, 1, 0}, {"do", wp_do, 1, 0}, {"?do", wp_do, 1, 1}, {"loop", wp_loop, 1, 0}, {"leave", w_leave, 1, 0}, {"+loop", wp_loop, 1, 1}, {"begin", w_begin, 1, 0}, {"while", w_while, 1, 0}, {"repeat", w_repeat, 1, 0}, {"again", w_again, 1, 0}, {"until", w_until, 1, 0}, {"unloop", w_unloop, 0, 0}, { /* end marker */ } };