forth/src/fh_runtime.c

#include <string.h>
#include <errno.h>
#include <ctype.h>

#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_builtins.h"
#include "fh_stack.h"
#include "fh_mem.h"
#include "fh_globals.h"
#include "fh_print.h"

struct fh_global_s fh_globals = {};

/** State names */
static const char *statenames[FH_STATE_MAX] = {
    [FH_STATE_INTERPRET] = "INTERPRET",
    [FH_STATE_COMPILE] = "COMPILE",
    [FH_STATE_QUIT] = "RUN",
    [FH_STATE_SHUTDOWN] = "SHUTDOWN",
};

/** Sub-state names */
static const char *substatenames[FH_SUBSTATE_MAX] = {
    [FH_SUBSTATE_NONE] = "NONE",
    [FH_SUBSTATE_COLON_NAME] = "COLON_NAME",
    [FH_SUBSTATE_S_QUOTE] = "S_QUOTE",
    [FH_SUBSTATE_DOT_QUOTE] = "DOT_QUOTE",
    [FH_SUBSTATE_PAREN_COMMENT] = "PAREN_COMMENT",
    [FH_SUBSTATE_LINE_COMMENT] = "LINE_COMMENT",
    [FH_SUBSTATE_EXIT] = "EXIT",
    [FH_SUBSTATE_SEE_NAME] = "SEE_NAME",
    [FH_SUBSTATE_POSTPONE_NAME] = "POSTPONE_NAME",
    [FH_SUBSTATE_CHAR] = "CHAR",
};

/** Add a word to the dictionary. */
enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
{
  enum fh_error rv;

  fh_align(fh);
  uint32_t ptr = fh->here;

  TRY(fh_heap_put(fh, w, DICTWORD_SIZE));

  //LOG("Added word \"%s\" at 0x%08x", w->name, ptr);

  // thread it onto the linked list
  fh_word_at(fh, ptr)->previous = fh->dict_last;
  fh->dict_last = ptr;

  return FH_OK;
}

/** Log current runtime state */
static void showstate(const struct fh_thread_s *fh)
{
  if (fh->substate == 0) {
    LOG("state = %s", statenames[fh->state]);
  } else {
    LOG("state = %s.%s", statenames[fh->state], substatenames[fh->substate]);
  }
}

/** Set runtime state and sub-state */
void fh_setstate(struct fh_thread_s *fh, enum fh_state state, enum fh_substate substate)
{
  fh->state = state;
  fh->substate = substate;
  showstate(fh);
}

/** Set runtime sub-state (state is unchanged) */
void fh_setsubstate(struct fh_thread_s *fh, enum fh_substate substate)
{
  fh->substate = substate;
  showstate(fh);
}

/** Execute a user word */
enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
{
  enum fh_error rv;
  const struct fh_word_s *w;
  const struct fh_word_s *w2;

  w = w0;
  call:
  if (!w) { return FH_ERR_INTERNAL; }

  LOG("Run user word: %s", w->name);

  TRY(rs_push(fh, fh->execptr));
  fh->execptr = w->param;

  instr:;
  if (fh->state == FH_STATE_QUIT) {
    /* abort or quit was called, return to interactive mode */
    fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
    return FH_OK;
  }
  // make sure it's aligned
  fh->execptr = WORDALIGNED(fh->execptr);
  const struct fh_instruction_s *instr = fh_instr_at(fh, fh->execptr);
  fh->execptr += INSTR_SIZE;

  uint32_t strl;
  uint32_t val;
  uint32_t addr = 0;

  struct fh_instruction_s instr2;
  switch (instr->kind) {
    case FH_INSTR_NUMBER:
      TRY(ds_push(fh, instr->data));
      goto instr;

    case FH_INSTR_POSTPONED_WORD:
      if (fh->state == FH_STATE_COMPILE) {
        w2 = fh_word_at(fh, instr->data);
        if (w2->flags & WORDFLAG_IMMEDIATE) {
          LOG("Call immediate postponed word: %s", w2->name);
          TRY(w2->handler(fh, w2));
        } else {
          LOG("Add postponed word: %s", w2->name);
          instr_init(&instr2, FH_INSTR_WORD, instr->data);
          TRY(fh_heap_put(fh, &instr, INSTR_SIZE));
        }
      } else {
        LOGE("Postpone in interpret mode!");
        goto end;
      }
      goto instr;

    case FH_INSTR_WORD:
      w2 = fh_word_at(fh, instr->data);
      if (w2->flags & WORDFLAG_BUILTIN) {
        LOG("Exec: builtin-word \"%s\"", w2->name);
        w2->handler(fh, w2);
        if (fh->substate == FH_SUBSTATE_EXIT) {
          fh_setsubstate(fh, 0);
          LOG("Exec: early return");
          TRY(rs_pop(fh, &fh->execptr));
          if (fh->execptr == MAGICADDR_INTERACTIVE) {
            goto end;
          }
        }
        goto instr;
      } else {
        LOG("Exec: user-word %s (CALL)", w2->name);
        w = fh_word_at(fh, instr->data);
        goto call;
      }

    case FH_INSTR_JUMPZERO:
      if (instr->data == MAGICADDR_UNRESOLVED) {
        LOGE("Encountered unresolved jump!");
        goto end;
      }

      TRY(ds_pop(fh, &val));
      if (0 == val) {
        fh->execptr = instr->data;
      }
      goto instr;

    case FH_INSTR_JUMP:
      if (instr->data == MAGICADDR_UNRESOLVED) {
        LOGE("Encountered unresolved jump!");
        goto end;
      }
      fh->execptr = instr->data;
      goto instr;

      /* special case for strings stored in compile memory */
    case FH_INSTR_ALLOCSTR:
    case FH_INSTR_TYPESTR:
      strl = instr->data;
      if (instr->kind == FH_INSTR_ALLOCSTR) {
        TRY(fh_heap_reserve(fh, strl, &addr));
        LOG("Exec: alloc-str \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
        fh_heap_copy(fh, addr, fh->execptr, strl);
        TRY(ds_push(fh, addr));
        TRY(ds_push(fh, strl));
      } else {
        LOG("Exec: type-str \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
        FHPRINT("%.*s", (int) strl, fh_str_at(fh, fh->execptr));
      }
      fh->execptr += strl;
      goto instr;

    case FH_INSTR_ENDWORD:
      LOG("Exec: word-end (RETURN)");
      TRY(rs_pop(fh, &fh->execptr));
      if (fh->execptr == MAGICADDR_INTERACTIVE) {
        goto end;
      }
      goto instr;
  }

  end:
  return FH_OK;
}


/** Initialize a runtime */
enum fh_error fh_init(struct fh_thread_s *fh)
{
  enum fh_error rv;

  /* Make sure we have a clean state */
  memset(fh, 0, sizeof(struct fh_thread_s));

  fh->dict_last = MAGICADDR_DICTFIRST;
  TRY(register_builtin_words(fh));

  fh->execptr = MAGICADDR_INTERACTIVE;
  fh->base = 10;
  return FH_OK;
}

/** Process a quoted string read from input */
static enum fh_error fh_handle_quoted_string(
    struct fh_thread_s *fh,
    const char *start,
    size_t len
)
{
  enum fh_error rv;
  uint32_t addr = 0;
  struct fh_instruction_s instr;

  if (fh->state == FH_STATE_INTERPRET) {
    switch (fh->substate) {
      case FH_SUBSTATE_S_QUOTE:
        addr = fh->here;
        TRY(fh_heap_put(fh, start, len));
        TRY(ds_push(fh, addr));
        TRY(ds_push(fh, len));
        break;
      case FH_SUBSTATE_DOT_QUOTE:
        FHPRINT("%.*s", (int) len, start);
        break;

      default:
        LOGE("Bad substate in interpret mode: %s", substatenames[fh->substate]);
    }
  } else {
    LOG("Compile a string");
    /* compile */
    if (fh->substate == FH_SUBSTATE_S_QUOTE) {
      instr_init(&instr, FH_INSTR_ALLOCSTR, len);
    } else {
      instr_init(&instr, FH_INSTR_TYPESTR, len);
    }
    TRY(fh_heap_put(fh, &instr, INSTR_SIZE));
    TRY(fh_heap_put(fh, start, len));
  }
  return FH_OK;
}

enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr)
{
  struct fh_instruction_s instr;
  enum fh_error rv;
  struct fh_word_s *w = fh_word_at(fh, addr);
  if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) {
    LOG("Compile word call: %s", w->name);
    instr_init(&instr, FH_INSTR_WORD, addr);
    TRY(fh_heap_put(fh, &instr, INSTR_SIZE));
  } else {
    /* interpret or immediate in compiled code */
    LOG("Run word: %s", w->name);
    TRY(w->handler(fh, w));
  }
  return FH_OK;
}

static struct fh_word_s *find_word(struct fh_thread_s *fh, const char *name, const size_t wordlen, uint32_t *addr_out)
{
  uint32_t addr = fh->dict_last;
  while (addr != MAGICADDR_DICTFIRST) {
    struct fh_word_s *w = fh_word_at(fh, addr);
    if (0 == strncasecmp(name, w->name, wordlen) && w->name[wordlen] == 0) {
      if (addr_out) {
        *addr_out = addr;
      }
      return w;
    }
    addr = w->previous;
  }
  return NULL;
}

/** Process a word read from input */
enum fh_error fh_handle_ascii_word(
    struct fh_thread_s *fh,
    const char *name,
    const size_t wordlen
)
{
  enum fh_error rv;
  if (wordlen >= MAX_NAME_LEN) {
    return FH_ERR_NAME_TOO_LONG;
  }

  /* First, try if it's a known word */

  uint32_t wadr = MAGICADDR_UNRESOLVED;
  find_word(fh, name, wordlen, &wadr);
  if (wadr != MAGICADDR_UNRESOLVED) {
    TRY(fh_handle_word(fh, wadr));
    return FH_OK;
  }

  /* word not found, try parsing as number */
  errno = 0;
  char *endptr;
  int base = (int) fh->base;

  // prefix can override BASE - this is a syntax extension
  if (name[0] == '0') {
    if (name[1] == 'x') {
      base = 16;
    } else if (name[1] == 'b') {
      base = 2;
    } else if (name[1] == 'o') {
      base = 8;
    }
  }

  long v = strtol(name, &endptr, base); // XXX if base is 0, this will use auto-detection
  if (errno != 0 || (endptr - name) != wordlen) {
    LOGE("Unknown word and fail to parse as number: \"%.*s\"", (int) wordlen, name);
    return FH_ERR_UNKNOWN_WORD;
  }

  struct fh_instruction_s instr;
  if (fh->state == FH_STATE_COMPILE) {
    LOG("Compile number: %ld", v);
    instr_init(&instr, FH_INSTR_NUMBER, (uint32_t) v);
    TRY(fh_heap_put(fh, &instr, INSTR_SIZE));
  } else {
    /* interpret */
    LOG("Interpret number: %ld", v);
    TRY(ds_push(fh, (uint32_t) v));
  }

  return FH_OK;
}

static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  if (w->handler == w_user_word) {
    uint32_t execptr = w->param;

    instr:;
    // make sure it's aligned
    execptr = WORDALIGNED(execptr);
    FHPRINT("0x%08x: ", execptr);
    const struct fh_instruction_s *instr = fh_instr_at(fh, execptr);
    execptr += INSTR_SIZE;

    uint32_t strl;
    uint32_t wn;
    const struct fh_word_s *w2;
    switch (instr->kind) {
      case FH_INSTR_NUMBER:
        FHPRINT("Number(%d)\n", instr->data);
        goto instr;

      case FH_INSTR_WORD:
        w2 = fh_word_at(fh, instr->data);
        if (w2->name[0]) {
          FHPRINT("Call(%s)\n", w2->name);
        } else {
          FHPRINT("Call(0x%08x)\n", instr->data);
        }
        goto instr;

      case FH_INSTR_POSTPONED_WORD:
        w2 = fh_word_at(fh, instr->data);
        if (w2->name[0]) {
          FHPRINT("Postpone(%s)\n", w2->name);
        } else {
          FHPRINT("Postpone(0x%08x)\n", instr->data);
        }
        goto instr;

      case FH_INSTR_JUMPZERO:
        FHPRINT("JumpIfZero(0x%08x)\n", instr->data);
        goto instr;

      case FH_INSTR_JUMP:
        FHPRINT("Jump(0x%08x)\n", instr->data);
        goto instr;

        /* special case for strings stored in compile memory */
      case FH_INSTR_ALLOCSTR:
      case FH_INSTR_TYPESTR:
        strl = instr->data;
        if (instr->kind == FH_INSTR_ALLOCSTR) {
          FHPRINT("AllocStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr));
          execptr += strl;
        } else {
          FHPRINT("PrintStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr));
          execptr += strl;
        }
        goto instr;

      case FH_INSTR_ENDWORD:
        FHPRINT("END\n");
        return;
    }

  } else {
    FHPRINT("(builtin)");
  }
}

/** Decompile a word */
static enum fh_error fh_see_word(
    struct fh_thread_s *fh,
    const char *name,
    const size_t wordlen
)
{
  struct fh_word_s *w = find_word(fh, name, wordlen, NULL);
  if (!w) {
    return FH_ERR_UNKNOWN_WORD;
  }
  show_word(fh, w);
  return FH_OK;
}

/** Postpone a word */
static enum fh_error fh_postpone_word(
    struct fh_thread_s *fh,
    const char *name,
    const size_t wordlen
)
{
  uint32_t wadr;
  struct fh_word_s *w = find_word(fh, name, wordlen, &wadr);
  if (!w) {
    return FH_ERR_UNKNOWN_WORD;
  }

  enum fh_error rv;
  struct fh_instruction_s instr;
  LOG("Postpone %s", w->name);
  instr_init(&instr, FH_INSTR_POSTPONED_WORD, wadr);
  TRY(fh_heap_put(fh, &instr, INSTR_SIZE));

  return FH_OK;
}

/** True if the character is CR or LF */
static inline bool isnl(char c)
{
  return c == '\n' || c == '\r';
}

/** Process a line read from input */
enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_t len)
{
  enum fh_error rv;

#define ReadPtr ((char*)(&fh->heap[INPUTBUF_ADDR + fh->inputptr]))
#define ReadPos (fh->inputptr)
#define ReadLen (fh->inputlen)

  fh_fill_input_buffer(fh, linebuf, len);

  char c;

  if (!fh_globals.interactive) {
    LOGI("%s", linebuf);
  }

  while (ReadPos < ReadLen && fh->state != FH_STATE_SHUTDOWN) {
    c = *ReadPtr;
    /* end on newline */
    if (isnl(c)) {
      goto done;
    }
    /* skip whitespace */
    if (isspace(c)) {
      ReadPos++;
      continue;
    }

    const char * const rp = ReadPtr;

    char *end;
    size_t length;
    switch (fh->substate) {
      case FH_SUBSTATE_NONE:
      case FH_SUBSTATE_COLON_NAME:
      case FH_SUBSTATE_SEE_NAME:
      case FH_SUBSTATE_POSTPONE_NAME:
        /* try to read a word */
        end = strchr(rp, ' ');
        if (end) {
          length = end - rp; /* exclude the space */
        } else {
          length = strlen(rp);
        }

        switch (fh->substate) {
          case FH_SUBSTATE_NONE:
            /* eval a word */
            LOG("Handle \"%.*s\"", (int) length, rp);
            TRY(fh_handle_ascii_word(fh, rp, length));
            break;
          case FH_SUBSTATE_COLON_NAME:
            /* new word's name is found */
            LOG("New word name = \"%.*s\"", (int) length, rp);
            strncpy(fh_word_at(fh, fh->dict_last)->name, rp, length);
            fh_setsubstate(fh, FH_SUBSTATE_NONE);
            break;
          case FH_SUBSTATE_SEE_NAME:
            TRY(fh_see_word(fh, rp, length));
            fh_setsubstate(fh, FH_SUBSTATE_NONE);
            break;
          case FH_SUBSTATE_POSTPONE_NAME:
            TRY(fh_postpone_word(fh, rp, length));
            fh_setsubstate(fh, FH_SUBSTATE_NONE);
            break;
        }

        if (end) {
          ReadPos += length + 1;
        } else {
          goto done;
        }
        break;

      case FH_SUBSTATE_S_QUOTE:
      case FH_SUBSTATE_DOT_QUOTE:
        end = strchr(rp, '"');
        if (end) {
          length = end - rp;
          LOG("Quoted string: \"%.*s\"", (int) length, rp);
          TRY(fh_handle_quoted_string(fh, rp, length));
          fh_setsubstate(fh, FH_SUBSTATE_NONE);
          ReadPos += length + 1;
        } else {
          /* no end. this is weird. */
          LOGE("Unterminated quoted string!");
          goto done;
        }
        break;

      case FH_SUBSTATE_PAREN_COMMENT:
        end = strchr(rp, ')');
        if (end) {
          length = end - rp;
          LOG("Discard inline comment");
          fh_setsubstate(fh, FH_SUBSTATE_NONE);
          ReadPos += length + 1;
        } else {
          /* no end, discard all */
          LOGE("Unterminated parenthesis comment");
          goto done;
        }
        break;

      case FH_SUBSTATE_LINE_COMMENT:
        LOG("Discard line comment");
        goto done; // just discard the rest

      default:
        LOGE("Bad substate %s", substatenames[fh->substate]);
    }
  }
  done:
  LOG("Line done.");
  return FH_OK;
}