Trying to build a forth runtime in C
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
forth/src/fh_builtins_control.c

236 lines
5.8 KiB

#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "fh_stack.h"
#include "fh_print.h"
#include "fh_builtins.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->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->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->kind == FH_INSTR_DO_QUESTION && ii->data == MAGICADDR_UNRESOLVED) {
ii->data = endaddr;
}
while (startaddr < loopendaddr) {
ii = fh_instr_at(fh, startaddr);
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_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->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},
{ /* end marker */ }
};