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_stack.c

257 lines
5.5 KiB

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