forth/src/fh_builtins_meta.c

#include <string.h>
#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "fh_stack.h"
#include "fh_print.h"
#include "fh_builtins.h"
#include "fh_parse.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);
  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);
  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 w_read_value(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  enum fh_error rv;
  ENSURE_STATE(FH_STATE_INTERPRET);
  TRY(ds_push(fh, w->param));
  return FH_OK;
}

static enum fh_error w_read_varaddr(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  enum fh_error rv;
  ENSURE_STATE(FH_STATE_INTERPRET);

  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;
  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;

  bool is_value = w->param == 1;
  bool is_const = w->param == 2;

  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);
  new_word->previous = fh->dict_last;
  new_word->param = value;
  new_word->handler = (is_value || is_const) ? w_read_value : w_read_varaddr;
  strncpy(new_word->name, wordname, namelen);
  new_word->name[namelen] = 0;
  new_word->flags = (is_const ? WORDFLAG_CONSTANT : WORDFLAG_VARIABLE) | WORDFLAG_BUILTIN;

  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->flags & WORDFLAG_CONSTANT) {
      LOGE("Cannot assign to constant!");
      return FH_ERR_ILLEGAL_STORE;
    }

    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;
  }

  fh_word_at(fh, fh->dict_last)->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 w_char(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;

  char *wordname = NULL;
  size_t namelen = 0;
  fh_input_consume_spaces(fh);
  TRY(fh_input_read_word(fh, &wordname, &namelen));
  TRY(ds_push(fh, (char) *wordname));
  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;
}

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",      w_char,         0, 0},
    {"[char]",    w_char,         1, 0},
    {"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},

    { /* end marker */ }
};