forth/src/fh_builtins_stack.c

#include "forth_internal.h"

static enum fh_error w_dupe(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a = 0;
  TRY(ds_peek(fh, &a));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_nip(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a = 0, discard = 0;
  TRY(ds_pop(fh, &a));
  TRY(ds_pop(fh, &discard));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_question_dupe(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a = 0;
  TRY(ds_peek(fh, &a));
  if (a) {
    TRY(ds_push(fh, a));
  }
  return FH_OK;
}

static enum fh_error w_two_dup(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a = 0;
  uint32_t b = 0;
  TRY(ds_peek_n(fh, &a, 0));
  TRY(ds_peek_n(fh, &b, 1));
  TRY(ds_push(fh, b));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_drop(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a = 0;
  TRY(ds_pop(fh, &a));
  return FH_OK;
}

static enum fh_error w_two_drop(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a = 0;
  TRY(ds_pop(fh, &a));
  TRY(ds_pop(fh, &a));
  return FH_OK;
}

static enum fh_error w_swap(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  TRY(ds_roll(fh, 1));
  return FH_OK;
}

static enum fh_error w_two_swap(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;

  uint32_t a, b, c, d;
  TRY(ds_pop(fh, &a));
  TRY(ds_pop(fh, &b));
  TRY(ds_pop(fh, &c));
  TRY(ds_pop(fh, &d));

  TRY(ds_push(fh, b));
  TRY(ds_push(fh, a));
  TRY(ds_push(fh, d));
  TRY(ds_push(fh, c));
  return FH_OK;
}

static enum fh_error w_rot(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  TRY(ds_roll(fh, 2));
  return FH_OK;
}

static enum fh_error w_over(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a = 0;
  TRY(ds_peek_n(fh, &a, 1));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_two_over(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a = 0;
  uint32_t b = 0;
  TRY(ds_peek_n(fh, &a, 2));
  TRY(ds_peek_n(fh, &b, 3));
  TRY(ds_push(fh, b));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_tuck(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a = 0;
  uint32_t b = 0;
  TRY(ds_pop(fh, &a));
  TRY(ds_pop(fh, &b));
  TRY(ds_push(fh, a));
  TRY(ds_push(fh, b));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_pick(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t nth = 0;
  uint32_t a = 0;
  TRY(ds_pop(fh, &nth));
  TRY(ds_peek_n(fh, &a, nth));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_roll(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t n = 0;
  TRY(ds_pop(fh, &n));
  TRY(ds_roll(fh, n));
  return FH_OK;
}

static enum fh_error w_to_r(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a;
  TRY(ds_pop(fh, &a));
  TRY(rs_push(fh, a));
  return FH_OK;
}

static enum fh_error w_two_to_r(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a;
  uint32_t b;
  TRY(ds_pop(fh, &a));
  TRY(ds_pop(fh, &b));
  TRY(rs_push(fh, b));
  TRY(rs_push(fh, a));
  return FH_OK;
}

static enum fh_error w_two_r_from(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a;
  uint32_t b;
  TRY(rs_pop(fh, &a));
  TRY(rs_pop(fh, &b));
  TRY(ds_push(fh, b));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_two_r_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a;
  uint32_t b;
  TRY(rs_peek_n(fh, &a, 0));
  TRY(rs_peek_n(fh, &b, 1));
  TRY(ds_push(fh, b));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_r_from(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a;
  TRY(rs_pop(fh, &a));
  TRY(ds_push(fh, a));
  return FH_OK;
}

static enum fh_error w_r_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  (void) w;
  enum fh_error rv;
  uint32_t a;
  TRY(rs_peek(fh, &a));
  TRY(ds_push(fh, a));
  return FH_OK;
}


const struct name_and_handler fh_builtins_stack[] = {
    /* Stack manip */
    {"drop",      w_drop,            0, 0},
    {"dup",       w_dupe,            0, 0},
    {"?dup",      w_question_dupe,   0, 0},
    {"nip",       w_nip,             0, 0},
    {"over",      w_over,            0, 0},
    {"swap",      w_swap,            0, 0},
    {"rot",       w_rot,             0, 0},
    {"tuck",      w_tuck,            0, 0},
    {"pick",      w_pick,            0, 0},
    {"roll",      w_roll,            0, 0},
    /* Double wide stack manip */
    {"2drop",     w_two_drop,        0, 0},
    {"2dup",      w_two_dup,         0, 0},
    {"2over",     w_two_over,        0, 0},
    {"2swap",     w_two_swap,        0, 0},
    /* Return stack manip */
    {">r",        w_to_r,            0, 0},
    {"r>",        w_r_from,          0, 0},
    {"r@",        w_r_fetch,         0, 0},
    /* Double wide return stack manip */
    {"2>r",       w_two_to_r,        0, 0},
    {"2r>",       w_two_r_from,      0, 0},
    {"2r@",       w_two_r_fetch,     0, 0},
    { /* end marker */ }
};