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