MightyPork/forth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

many fixes and add some missing words

Browse Source
This commit is contained in:
MightyPork
2021-11-17 23:58:01 +01:00
parent dd12f8170a
commit e67d85d64e
27 changed files with 2631 additions and 351 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/fh_builtins.c
+1 -5
View File
@@ -1,8 +1,4 @@
#include <string.h>
#include "fh_runtime.h"
#include "fh_error.h"
#include "fh_print.h"
#include "fh_builtins.h"
#include "forth_internal.h"
enum fh_error fh_register_words_from_array(struct fh_thread_s *fh, const struct name_and_handler *p)
{
src/fh_builtins_arith.c
+220 -24
View File
@@ -1,9 +1,4 @@
#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 "forth_internal.h"
static enum fh_error wp_setbase(struct fh_thread_s *fh, const struct fh_word_s *w)
{
@@ -84,13 +79,35 @@ static enum fh_error w_xor(struct fh_thread_s *fh, const struct fh_word_s *w)
return FH_OK;
}
static enum fh_error w_lshift(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t a = 0, b = 0;
TRY(ds_pop(fh, &b));
TRY(ds_pop(fh, &a));
TRY(ds_push(fh, a << b));
return FH_OK;
}
static enum fh_error w_rshift(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t a = 0, b = 0;
TRY(ds_pop(fh, &b));
TRY(ds_pop(fh, &a));
TRY(ds_push(fh, a >> b));
return FH_OK;
}
static enum fh_error w_zero_less(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_push(fh, TOBOOL((int32_t)a < 0)));
TRY(ds_push(fh, TOBOOL((int32_t) a < 0)));
return FH_OK;
}
@@ -124,6 +141,27 @@ static enum fh_error w_zero_not_equals(struct fh_thread_s *fh, const struct fh_w
return FH_OK;
}
static enum fh_error w_min(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t a = 0, b = 0;
TRY(ds_pop(fh, &b));
TRY(ds_pop(fh, &a));
TRY(ds_push(fh, (int32_t) a < (int32_t) b ? a : b));
return FH_OK;
}
static enum fh_error w_max(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t a = 0, b = 0;
TRY(ds_pop(fh, &b));
TRY(ds_pop(fh, &a));
TRY(ds_push(fh, (int32_t) a < (int32_t) b ? b : a));
return FH_OK;
}
static enum fh_error w_less(struct fh_thread_s *fh, const struct fh_word_s *w)
{
@@ -215,7 +253,17 @@ static enum fh_error wp_div(struct fh_thread_s *fh, const struct fh_word_s *w)
enum fh_error rv;
uint32_t a = 0;
TRY(ds_pop(fh, &a));
TRY(ds_push(fh, a * w->param));
TRY(ds_push(fh, (int32_t) a / (int32_t) w->param));
return FH_OK;
}
static enum fh_error w_2div(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_push(fh, (a & 0x80000000) | (a >> 1)));
return FH_OK;
}
@@ -229,10 +277,10 @@ static enum fh_error w_star_slash(struct fh_thread_s *fh, const struct fh_word_s
TRY(ds_pop(fh, &a));
if (c == 0) {
return FH_ERR_DIV_BY_ZERO;
return FH_ERR_ARITH;
}
uint64_t v = ((uint64_t) a * (uint64_t) b) / (uint64_t) c;
int64_t v = ((int64_t) (int32_t)a * (int64_t) (int32_t)b) / (int64_t) (int32_t)c;
TRY(ds_push(fh, (uint32_t) v));
return FH_OK;
@@ -248,15 +296,15 @@ static enum fh_error w_star_slash_mod(struct fh_thread_s *fh, const struct fh_wo
TRY(ds_pop(fh, &a));
if (c == 0) {
return FH_ERR_DIV_BY_ZERO;
return FH_ERR_ARITH;
}
uint64_t product = ((uint64_t) a * (uint64_t) b);
uint64_t v = product / (uint64_t) c;
uint64_t m = product % (uint64_t) c;
int64_t product = ((int64_t) (int32_t)a * (int64_t) (int32_t)b);
int64_t v = product / (int64_t) (int32_t)c;
int64_t m = product % (int64_t) (int32_t)c;
TRY(ds_push(fh, (uint32_t) m));
TRY(ds_push(fh, (uint32_t) v));
TRY(ds_push(fh, (uint32_t) (int32_t)m));
TRY(ds_push(fh, (uint32_t) (int32_t)v));
return FH_OK;
}
@@ -269,10 +317,10 @@ static enum fh_error w_slash(struct fh_thread_s *fh, const struct fh_word_s *w)
TRY(ds_pop(fh, &a));
if (b == 0) {
return FH_ERR_DIV_BY_ZERO;
return FH_ERR_ARITH;
}
TRY(ds_push(fh, a / b));
TRY(ds_push(fh, (int32_t)a / (int32_t)b));
return FH_OK;
}
@@ -320,11 +368,11 @@ static enum fh_error w_slash_mod(struct fh_thread_s *fh, const struct fh_word_s
TRY(ds_pop(fh, &a));
if (b == 0) {
return FH_ERR_DIV_BY_ZERO;
return FH_ERR_ARITH;
}
uint32_t rem = a % b;
uint32_t div = a / b;
int32_t rem = (int32_t)a % (int32_t)b;
int32_t div = (int32_t)a / (int32_t)b;
TRY(ds_push(fh, rem));
TRY(ds_push(fh, div));
@@ -340,15 +388,153 @@ static enum fh_error w_mod(struct fh_thread_s *fh, const struct fh_word_s *w)
TRY(ds_pop(fh, &a));
if (b == 0) {
return FH_ERR_DIV_BY_ZERO;
return FH_ERR_ARITH;
}
uint32_t rem = a % b;
int32_t rem = (int32_t)a % (int32_t)b;
TRY(ds_push(fh, rem));
return FH_OK;
}
static enum fh_error w_s_to_d(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));
int32_t as = (int32_t) a; // because of sign extend
int64_t a64 = as;
TRY(ds_push_dw(fh, (uint64_t) a64));
return FH_OK;
}
static enum fh_error w_m_star(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t a = 0, b = 0;
TRY(ds_pop(fh, &a));
TRY(ds_pop(fh, &b));
// make signed and then sign extend
int64_t res = (int64_t) (int32_t) a * (int64_t) (int32_t) b;
TRY(ds_push_dw(fh, (uint64_t) res));
return FH_OK;
}
static enum fh_error w_um_star(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t a = 0, b = 0;
TRY(ds_pop(fh, &a));
TRY(ds_pop(fh, &b));
// make signed and then sign extend
uint64_t res = (uint64_t) a * (uint64_t) b;
TRY(ds_push_dw(fh, res));
return FH_OK;
}
// Copied from https://stackoverflow.com/a/51457071/2180189
void floor_div64(int64_t *q, int64_t *r, int64_t a, int64_t b)
{
int64_t q0 = a / b;
int64_t r0 = a % b;
if (b > 0){
*q = r0 >= 0 ? q0 : q0 - 1;
*r = r0 >= 0 ? r0 : r0 + b;
}
else {
*q = r0 <= 0 ? q0 : q0 - 1;
*r = r0 <= 0 ? r0 : r0 + b;
}
}
static enum fh_error w_fm_mod(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
int32_t div;
int64_t num;
TRY(ds_pop(fh, (uint32_t*)&div));
TRY(ds_pop_dw(fh, (uint64_t*)&num));
int64_t res, rem;
floor_div64(&res, &rem, num, div);
if ((int64_t)(int32_t)rem != rem) {
LOGE("Remainder too large");
return FH_ERR_ARITH;
}
if ((int64_t)(int32_t)res != res) {
LOGE("Division result too large");
return FH_ERR_ARITH;
}
TRY(ds_push(fh, (int32_t)rem));
TRY(ds_push(fh, (int32_t)res));
return FH_OK;
}
static enum fh_error w_um_mod(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t div;
uint64_t num;
TRY(ds_pop(fh, &div));
TRY(ds_pop_dw(fh, &num));
uint64_t res = num / (uint64_t)div; // TODO verify this may be wrong
uint64_t rem = num % (uint64_t)div;
if ((uint64_t)(uint32_t)rem != rem) {
LOGE("Remainder too large");
return FH_ERR_ARITH;
}
if ((uint64_t)(uint32_t)res != res) {
LOGE("Division result too large");
return FH_ERR_ARITH;
}
TRY(ds_push(fh, (uint32_t)rem));
TRY(ds_push(fh, (uint32_t)res));
return FH_OK;
}
static enum fh_error w_sm_rem(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
int32_t div;
int64_t num;
TRY(ds_pop(fh, (uint32_t*)&div));
TRY(ds_pop_dw(fh, (uint64_t*)&num));
int64_t res = num / (int64_t)div;
int64_t rem = num % (int64_t)div;
if ((int64_t)(int32_t)rem != rem) {
LOGE("Remainder too large");
return FH_ERR_ARITH;
}
if ((int64_t)(int32_t)res != res) {
LOGE("Division result too large");
return FH_ERR_ARITH;
}
TRY(ds_push(fh, (int32_t)rem));
TRY(ds_push(fh, (int32_t)res));
return FH_OK;
}
const struct name_and_handler fh_builtins_arith[] = {
/* Arithmetics */
{"base", wp_const, 0, MAGICADDR_BASE},
@@ -370,6 +556,10 @@ const struct name_and_handler fh_builtins_arith[] = {
{"mod", w_mod, 0, 0},
{"invert", w_invert, 0, 0},
{"negate", w_negate, 0, 0},
{"lshift", w_lshift, 0, 0},
{"rshift", w_rshift, 0, 0},
{"min", w_min, 0, 0},
{"max", w_max, 0, 0},
{"0<", w_zero_less, 0, 0},
{"0=", w_zero_equals, 0, 0},
{"0<>", w_zero_not_equals, 0, 0},
@@ -385,6 +575,12 @@ const struct name_and_handler fh_builtins_arith[] = {
{"2+", wp_add, 0, 2},
{"2-", wp_add, 0, -2},
{"2*", wp_mul, 0, 2},
{"2/", wp_div, 0, 2},
{"2/", w_2div, 0, 0},
{"s>d", w_s_to_d, 0, 0},
{"m*", w_m_star, 0, 0},
{"um*", w_um_star, 0, 0},
{"fm/mod", w_fm_mod, 0, 0},
{"sm/rem", w_sm_rem, 0, 0},
{"um/mod", w_um_mod, 0, 0},
{ /* end marker */ }
};
src/fh_builtins_control.c
+20 -10
View File
@@ -1,9 +1,4 @@
#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 "forth_internal.h"
static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w)
{
@@ -36,7 +31,7 @@ static enum fh_error w_else(struct fh_thread_s *fh, const struct fh_word_s *w)
uint32_t ifaddr = 0;
TRY(cs_pop(fh, &ifaddr));
struct fh_instruction_s *if_instr = fh_instr_at(fh, ifaddr);
if (if_instr->data != MAGICADDR_UNRESOLVED) {
if (!if_instr || if_instr->data != MAGICADDR_UNRESOLVED) {
LOGE("IF-ELSE control stack corruption");
return FH_ERR_INTERNAL;
}
@@ -57,7 +52,7 @@ static enum fh_error w_then(struct fh_thread_s *fh, const struct fh_word_s *w)
uint32_t ifaddr = 0;
TRY(cs_pop(fh, &ifaddr));
struct fh_instruction_s *if_instr = fh_instr_at(fh, ifaddr);
if (if_instr->data != MAGICADDR_UNRESOLVED) {
if (!if_instr || if_instr->data != MAGICADDR_UNRESOLVED) {
LOGE("IF-ELSE control stack corruption");
return FH_ERR_INTERNAL;
}
@@ -119,12 +114,16 @@ static enum fh_error wp_loop(struct fh_thread_s *fh, const struct fh_word_s *w)
// resolve ?DO dest
ii = fh_instr_at(fh, startaddr - INSTR_SIZE);
if (ii->kind == FH_INSTR_DO_QUESTION && ii->data == MAGICADDR_UNRESOLVED) {
if (!ii || ii->kind == FH_INSTR_DO_QUESTION && ii->data == MAGICADDR_UNRESOLVED) {
ii->data = endaddr;
}
while (startaddr < loopendaddr) {
ii = fh_instr_at(fh, startaddr);
if (!ii) {
LOGE("WHAT?");
return FH_ERR_INTERNAL;
}
if (ii->kind == FH_INSTR_LEAVE && ii->data == MAGICADDR_UNRESOLVED) {
LOG("Resolve leave addr");
ii->data = endaddr;
@@ -142,6 +141,16 @@ static enum fh_error wp_loop(struct fh_thread_s *fh, const struct fh_word_s *w)
return FH_OK;
}
static enum fh_error w_unloop(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t limit;
TRY(rs_pop(fh, &limit));
TRY(fh_loop_unnest(fh));
return FH_OK;
}
static enum fh_error w_leave(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
@@ -182,7 +191,7 @@ static enum fh_error w_repeat(struct fh_thread_s *fh, const struct fh_word_s *w)
TRY(cs_pop(fh, &origaddr));
struct fh_instruction_s *branch_instr = fh_instr_at(fh, origaddr);
if (branch_instr->data != MAGICADDR_UNRESOLVED) {
if (!branch_instr || branch_instr->data != MAGICADDR_UNRESOLVED) {
LOGE("REPEAT control stack corruption");
return FH_ERR_INTERNAL;
}
@@ -231,6 +240,7 @@ const struct name_and_handler fh_builtins_control[] = {
{"repeat", w_repeat, 1, 0},
{"again", w_again, 1, 0},
{"until", w_until, 1, 0},
{"unloop", w_unloop, 0, 0},
{ /* end marker */ }
};
src/fh_builtins_mem.c
+45 -6
View File
@@ -1,9 +1,4 @@
#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 "forth_internal.h"
static enum fh_error w_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
{
@@ -117,6 +112,46 @@ static enum fh_error w_comma(struct fh_thread_s *fh, const struct fh_word_s *w)
return FH_OK;
}
static enum fh_error w_c_comma(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t value = 0;
TRY(ds_pop(fh, &value));
TRY(fh_heap_put(fh, &value, 1));
return FH_OK;
}
static enum fh_error w_c_store(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t addr;
TRY(ds_pop(fh, &addr));
uint32_t value = 0;
TRY(ds_pop(fh, &value));
TRY(fh_store_char(fh, addr, (char) value));
return FH_OK;
}
static enum fh_error w_c_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t addr;
TRY(ds_pop(fh, &addr));
char value = 0;
TRY(fh_fetch_char(fh, addr, &value));
TRY(ds_push(fh, (uint32_t) value));
return FH_OK;
}
static enum fh_error w_align(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
@@ -161,7 +196,11 @@ const struct name_and_handler fh_builtins_mem[] = {
{"allot", w_allot, 0, 0},
{"align", w_align, 0, 0},
{",", w_comma, 0, 0},
{"c,", w_c_comma, 0, 0},
{"c@", w_c_fetch, 0, 0},
{"c!", w_c_store, 0, 0},
{"here", w_here, 0, 0},
{"state", wp_const, 0, MAGICADDR_STATE},
{"pad", w_pad, 0, 0},
{ /* end marker */ }
src/fh_builtins_meta.c
+35 -15
View File
@@ -1,11 +1,4 @@
#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"
#include "forth_internal.h"
static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
{
@@ -25,6 +18,7 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
struct fh_word_s *new_word = fh_word_at(fh, ptr);
if (!new_word) return FH_ERR_INTERNAL;
new_word->previous = fh->dict_last;
new_word->param = fh->here;
new_word->handler = w_user_word;
@@ -53,6 +47,7 @@ static enum fh_error w_forget(struct fh_thread_s *fh, const struct fh_word_s *w)
TRY(fh_find_word(fh, wordname, namelen, &addr));
struct fh_word_s *removedword = fh_word_at(fh, addr);
if (!removedword) return FH_ERR_INTERNAL;
fh->dict_last = removedword->previous;
return FH_OK;
}
@@ -91,6 +86,16 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s
{
(void) w;
enum fh_error rv;
bool is_value = w->param == 1;
bool is_const = w->param == 2;
if (is_const && fh->state == FH_STATE_COMPILE) {
uint32_t wordaddr = (void *)w - (void *)&fh->heap[0]; // this is ugly
TRY(fh_put_instr(fh, FH_INSTR_WORD, wordaddr));
return FH_OK;
}
ENSURE_STATE(FH_STATE_INTERPRET);
char *wordname;
@@ -101,9 +106,6 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s
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));
}
@@ -111,6 +113,7 @@ static enum fh_error wp_variable(struct fh_thread_s *fh, const struct fh_word_s
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
struct fh_word_s *new_word = fh_word_at(fh, ptr);
if (!new_word) return FH_ERR_INTERNAL;
new_word->previous = fh->dict_last;
new_word->param = value;
new_word->handler = (is_value || is_const) ? rt_read_value : rt_read_varaddr;
@@ -147,10 +150,16 @@ static enum fh_error w_to(struct fh_thread_s *fh, const struct fh_word_s *w)
TRY(fh_find_word(fh, wordname, namelen, &waddr));
struct fh_word_s *ww = fh_word_at(fh, waddr);
if (!ww) return FH_ERR_INTERNAL;
if (ww->flags & WORDFLAG_WORD) {
LOGE("Cannot assign to dictionary word param field!");
return FH_ERR_NOT_APPLICABLE;
}
if (ww->flags & WORDFLAG_CONSTANT) {
LOGE("Cannot assign to constant!");
return FH_ERR_ILLEGAL_STORE;
return FH_ERR_NOT_APPLICABLE;
}
ww->param = value;
@@ -236,7 +245,9 @@ static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s
return FH_ERR_INVALID_STATE;
}
fh_word_at(fh, fh->dict_last)->flags |= WORDFLAG_IMMEDIATE;
struct fh_word_s *word = fh_word_at(fh, fh->dict_last);
if (!word) return FH_ERR_INTERNAL;
word->flags |= WORDFLAG_IMMEDIATE;
return FH_OK;
}
@@ -365,6 +376,7 @@ static enum fh_error w_create(struct fh_thread_s *fh, const struct fh_word_s *w)
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
struct fh_word_s *new_word = fh_word_at(fh, ptr);
if (!new_word) return FH_ERR_INTERNAL;
new_word->previous = fh->dict_last;
new_word->param = fh->here;
new_word->handler = rt_read_value;
@@ -398,6 +410,7 @@ static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w)
}
struct fh_word_s *word = fh_word_at(fh, addr);
if (!word) return FH_ERR_INTERNAL;
TRY(ds_push(fh, addr));
TRY(ds_push(fh, (word->flags & WORDFLAG_IMMEDIATE) ? 1 : -1));
@@ -445,6 +458,10 @@ static enum fh_error w_execute(struct fh_thread_s *fh, const struct fh_word_s *w
}
struct fh_word_s *word = fh_word_at(fh, addr);
if (!word) {
LOGE("Execute with bad addr");
return FH_ERR_NOT_APPLICABLE;
}
if (!word->handler) {
LOGE("Execute word with no handler");
return FH_ERR_NOT_APPLICABLE;
@@ -463,8 +480,12 @@ static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s
uint32_t addr;
TRY(ds_pop(fh, &addr));
const char *str = fh_str_at(fh, addr);
if (!str) {
LOGE("Bad string addr for env query!");
return FH_ERR_NOT_APPLICABLE;
}
#define EQ(a, b, n) (0 == strncasecmp((a), (b), n) && (b)[n]==0)
LOG("Test environment \"%.*s\"", len, str);
if (EQ(str, "/COUNTED-STRING", len)) {
TRY(ds_push(fh, 255));
@@ -522,7 +543,6 @@ static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s
TRY(ds_push(fh, 0));
}
#undef EQ
return FH_OK;
}
src/fh_builtins_stack.c
+1 -4
View File
@@ -1,7 +1,4 @@
#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_stack.h"
#include "fh_builtins.h"
#include "forth_internal.h"
static enum fh_error w_dupe(struct fh_thread_s *fh, const struct fh_word_s *w)
{
src/fh_builtins_system.c
+12 -9
View File
@@ -1,17 +1,9 @@
#include "forth.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 "forth_internal.h"
// extension
static enum fh_error w_reset(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_INTERPRET);
fh_init(fh);
@@ -35,10 +27,21 @@ static enum fh_error w_debug(struct fh_thread_s *fh, const struct fh_word_s *w)
return FH_OK;
}
static enum fh_error w_exit(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
// let's just hope the return stack is not clobbered!
TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 0));
return FH_OK;
}
const struct name_and_handler fh_builtins_system[] = {
{"reset", w_reset, 1, 0},
{"bye", w_bye, 0, 0},
{"debug", w_debug, 0, 0},
{"exit", w_exit, 1, 0},
{ /* end marker */ }
};
src/fh_builtins_text.c
+9 -9
View File
@@ -1,10 +1,4 @@
#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"
#include "forth_internal.h"
/**
* Encode a code point using UTF-8
@@ -86,7 +80,12 @@ static enum fh_error w_type(struct fh_thread_s *fh, const struct fh_word_s *w)
TRY(ds_pop(fh, &count));
TRY(ds_pop(fh, &addr));
FHPRINT("%.*s", count, fh_str_at(fh, addr));
const char *str = fh_str_at(fh, addr);
if (!str) {
LOGE("Type addr out of bounds!");
return FH_ERR_NOT_APPLICABLE;
}
FHPRINT("%.*s", count, str);
return FH_OK;
}
@@ -161,7 +160,8 @@ static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w
TRY(ds_push(fh, len));
} else {
LOG("Compile a string: \"%.*s\"", len, start);
instr_init(&instr, FH_INSTR_ALLOCSTR, len);
instr.kind = FH_INSTR_ALLOCSTR;
instr.data = len;
fh_heap_write(fh, addr - INSTR_SIZE, &instr, INSTR_SIZE);
}
src/fh_error.c
+2 -2
View File
@@ -1,4 +1,4 @@
#include "fh_error.h"
#include "forth_internal.h"
/** Error names */
static const char *errornames[FH_ERR_MAX] = {
@@ -18,7 +18,7 @@ static const char *errornames[FH_ERR_MAX] = {
[FH_ERR_UNKNOWN_WORD] = "UNKNOWN_WORD",
[FH_ERR_ILLEGAL_FETCH] = "ILLEGAL_FETCH",
[FH_ERR_ILLEGAL_STORE] = "ILLEGAL_STORE",
[FH_ERR_DIV_BY_ZERO] = "DIV_BY_ZERO",
[FH_ERR_ARITH] = "ARITHMETIC_ERROR",
[FH_ERR_SYNTAX] = "SYNTAX_ERROR",
[FH_ERR_NOT_APPLICABLE] = "NOT_APPLICABLE",
};
src/fh_mem.c
+17 -11
View File
@@ -1,10 +1,4 @@
#include <string.h>
#include <assert.h>
#include "fh_print.h"
#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "forth_internal.h"
// Important distinction: HEAP_END is the end of the normally addressable region. HEAP_SIZE is the full memory area.
// Buffers are placed at the end of the heap!
@@ -41,6 +35,11 @@ enum fh_error fh_fetch(struct fh_thread_s *fh, uint32_t addr, uint32_t *dst)
LOG("Fetch here %d", *dst);
break;
case MAGICADDR_STATE:
*dst = TOBOOL(fh->state==FH_STATE_COMPILE);
LOG("Fetch state %d", *dst);
break;
case MAGICADDR_INPTR:
*dst = fh->inputptr;
LOG("Fetch >IN %d", *dst);
@@ -86,6 +85,10 @@ enum fh_error fh_store(struct fh_thread_s *fh, uint32_t addr, uint32_t val)
LOGE("HERE is read-only!");
return FH_ERR_ILLEGAL_STORE;
case MAGICADDR_STATE:
LOGE("STATE is read-only!");
return FH_ERR_ILLEGAL_STORE;
case MAGICADDR_INPTR:
LOG("set >IN %d", val);
fh->inputptr = val;
@@ -138,10 +141,8 @@ enum fh_error fh_heap_reserve(
*addr = p;
}
// Erase the region. This is out of abundance of caution, not really needed if it was erased initially. Maybe.
memset(&fh->heap[p], 0, len);
fh->here = WORDALIGNED(p + len);
fh->here = p + len;
//fh->here = WORDALIGNED(p + len);
return FH_OK;
}
@@ -158,6 +159,8 @@ void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint3
}
enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fh_instruction_kind kind, uint32_t data) {
fh_align(fh);
struct fh_instruction_s instr = {
.kind = kind,
.data = data,
@@ -192,6 +195,7 @@ void fh_heap_copyptr(struct fh_thread_s *fh, uint32_t addr, char * source, uint3
char *fh_str_at(struct fh_thread_s *fh, uint32_t addr) {
if (addr >= HEAP_SIZE) {
LOGE("fh_str_at out of bounds!");
return NULL;
}
return (char *) &fh->heap[addr];
}
@@ -199,6 +203,7 @@ char *fh_str_at(struct fh_thread_s *fh, uint32_t addr) {
struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr) {
if (addr >= HEAP_END) {
LOGE("fh_instr_at out of bounds!");
return NULL;
}
return (void *) &fh->heap[addr];
}
@@ -206,6 +211,7 @@ struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr) {
struct fh_word_s *fh_word_at(struct fh_thread_s *fh, uint32_t addr) {
if (addr >= HEAP_END) {
LOGE("fh_word_at out of bounds!");
return NULL;
}
return (struct fh_word_s *) &fh->heap[addr];
}
src/fh_parse.c
+185 -7
View File
@@ -1,10 +1,65 @@
#include <ctype.h>
#include <stdint.h>
#include <stddef.h>
#include "fh_print.h"
#include "fh_runtime.h"
#include "fh_error.h"
#include "fh_parse.h"
#include "forth_internal.h"
/** True if the character is CR or LF */
static inline bool isnl(char c)
{
return c == '\n' || c == '\r';
}
/** 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 = 0;
if (FH_OK == fh_find_word(fh, name, wordlen, &wadr)) {
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;
}
if (fh->state == FH_STATE_COMPILE) {
LOG("\x1b[34m[COM] Compile number:\x1b[m %ld", v);
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, (uint32_t) v));
} else {
/* interpret */
LOG("\x1b[35m[INT] Push number:\x1b[m %ld", v);
TRY(ds_push(fh, (uint32_t) v));
}
return FH_OK;
}
void fh_input_consume_matching(struct fh_thread_s *fh, chartest_t test, void* param) {
char *rp = (char *) &fh->heap[INPUTBUF_ADDR + fh->inputptr];
@@ -141,3 +196,126 @@ enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, c
LOGE("String too long!");
return FH_ERR_SYNTAX;
}
/** 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.echo && !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:
/* try to read a word */
end = strchr(rp, ' ');
if (end) {
length = end - rp; /* exclude the space */
} else {
length = strlen(rp);
}
ReadPos += length + 1;
if (EQ(rp, "[if]", length)) {
if (0 == fh->parse_if_level) {
uint32_t val;
TRY(ds_pop(fh, &val));
if (!val) {
LOG("\x1b[32m[if] false, start skipping\x1b[m");
fh->parse_if_level++;
} else {
LOG("\x1b[32m[if] true, proceed\x1b[m");
}
} else {
LOG("\x1b[32m[if] nest+\x1b[m");
fh->parse_if_level++;
}
} else if (EQ(rp, "[else]", length)) {
if (fh->parse_if_level == 1) {
// we got here by running the [if] branch
LOG("\x1b[32m[else] end of false skip\x1b[m");
fh->parse_if_level--;
}
} else if (EQ(rp, "[then]", length)) {
if (fh->parse_if_level > 0) {
fh->parse_if_level--;
if (fh->parse_if_level == 0) {
LOG("\x1b[32m[then] end of skipped section\x1b[m");
} else {
LOG("\x1b[32m[then] nest-\x1b[m");
}
} else {
LOG("\x1b[32m[then] end of conditional\x1b[m");
}
} else if (fh->parse_if_level == 0) {
/* eval a word */
//LOG("Handle \"%.*s\"", (int) length, rp);
TRY(fh_handle_ascii_word(fh, rp, length));
} else {
if (EQ(rp, "\\", length)) {
// discard to EOL
LOG("Discard \"%.*s\"", fh->inputlen - fh->inputptr + length, rp);
goto done;
}
LOG("Discard \"%.*s\"", length, rp);
}
if (!end) {
goto done;
}
break;
case FH_SUBSTATE_PAREN_COMMENT:
end = strchr(rp, ')');
if (end) {
length = end - rp;
LOG("Discard inline comment: \"%.*s\"", length, rp);
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: \"%.*s\"", fh->inputlen - fh->inputptr, rp);
fh_setsubstate(fh, 0);
goto done; // just discard the rest
default:
LOGE("Bad substate %s", substatenames[fh->substate]);
}
}
done:
//LOG("Line done.");
return FH_OK;
}
src/fh_runtime.c
+40 -162
View File
@@ -1,14 +1,4 @@
#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"
#include "forth_internal.h"
struct fh_global_s fh_globals = {};
@@ -29,11 +19,12 @@ static const char *stateshort[FH_STATE_MAX] = {
};
/** Sub-state names */
static const char *substatenames[FH_SUBSTATE_MAX] = {
const char *substatenames[FH_SUBSTATE_MAX] = {
[FH_SUBSTATE_NONE] = "NONE",
[FH_SUBSTATE_PAREN_COMMENT] = "PAREN_COMMENT",
[FH_SUBSTATE_LINE_COMMENT] = "LINE_COMMENT",
[FH_SUBSTATE_EXIT] = "EXIT",
[FH_SUBSTATE_SKIP_IF] = "SKIP_IF",
};
/** Sub-state names */
@@ -76,7 +67,9 @@ enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh)
//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;
struct fh_word_s *word = fh_word_at(fh, ptr);
if (!word) return FH_ERR_INTERNAL;
word->previous = fh->dict_last;
fh->dict_last = ptr;
return FH_OK;
@@ -132,6 +125,10 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
// make sure it's aligned
fh->execptr = WORDALIGNED(fh->execptr);
const struct fh_instruction_s *instr = fh_instr_at(fh, fh->execptr);
if (!instr) {
LOGE("Execution pointer out of bounds!");
return FH_ERR_INTERNAL;
}
fh->execptr += INSTR_SIZE;
uint32_t strl;
@@ -145,8 +142,12 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
goto instr;
case FH_INSTR_POSTPONED_WORD:
if (fh->state == FH_STATE_COMPILE) {
//if (fh->state == FH_STATE_COMPILE) {
w2 = fh_word_at(fh, instr->data);
if (!w2) {
LOGE("Postponed bad word addr!");
return FH_ERR_INTERNAL;
}
if (w2->flags & WORDFLAG_IMMEDIATE) {
LOG("Call immediate postponed word: %s", w2->name);
TRY(w2->handler(fh, w2));
@@ -154,17 +155,21 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
LOG("Add postponed word: %s", w2->name);
TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data));
}
} else {
/*} else {
LOGE("Postpone in interpret mode!");
goto end;
}
}*/
goto instr;
case FH_INSTR_WORD:
w2 = fh_word_at(fh, instr->data);
if (!w2) {
LOGE("Instr bad word addr!");
return FH_ERR_INTERNAL;
}
if (w2->flags & WORDFLAG_BUILTIN) {
LOG("Exec: native-word \"%s\"", w2->name);
w2->handler(fh, w2);
TRY(w2->handler(fh, w2));
if (fh->substate == FH_SUBSTATE_EXIT) {
fh_setsubstate(fh, 0);
LOG("Exec: early return");
@@ -177,6 +182,10 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
} else {
LOG("Exec: user-word %s (CALL)", w2->name);
w = fh_word_at(fh, instr->data);
if (!w) {
LOGE("CALL instr bad word addr!");
return FH_ERR_INTERNAL;
}
goto call;
}
@@ -203,6 +212,10 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
case FH_INSTR_TO:
TRY(ds_pop(fh, &val));
w2 = fh_word_at(fh, instr->data);
if (!w2) {
LOGE("TO instr bad variable addr!");
return FH_ERR_INTERNAL;
}
LOG("Exec: %d->%s", val, w2->name);
if (w2->flags & WORDFLAG_CONSTANT) {
@@ -255,7 +268,8 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
LOG("after add: %d", fh->loop_i);
if (((int32_t)index0 < (int32_t)limit) == ((int32_t)fh->loop_i < (int32_t)limit)) { // boundary not crossed, continue
// FIXME this is probably wrong
if (((int32_t)index0 < (int32_t)limit) == ((int32_t)fh->loop_i < (int32_t)limit) && fh->loop_i != limit) { // boundary not crossed, continue
fh->execptr = instr->data; // go to beginning
} else {
// end of loop
@@ -290,7 +304,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
goto instr;
case FH_INSTR_ENDWORD:
LOG("Exec: word-end (RETURN)");
LOG("Exec: word-end");
TRY(rs_pop(fh, &fh->execptr));
if (fh->execptr == MAGICADDR_EXEC_INTERACTIVE) {
goto end;
@@ -323,6 +337,7 @@ enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr)
{
enum fh_error rv;
struct fh_word_s *w = fh_word_at(fh, addr);
if (!w) return FH_ERR_INTERNAL;
if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) {
LOG("\x1b[34m[%s] Compile word:\x1b[m %s", stateshort[fh->state], w->name);
TRY(fh_put_instr(fh, FH_INSTR_WORD, addr));
@@ -341,12 +356,18 @@ enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr)
enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t wordlen, uint32_t *addr_out)
{
if (name == NULL) {
return FH_ERR_UNKNOWN_WORD;
}
if (wordlen == 0) {
wordlen = strlen(name);
}
uint32_t addr = fh->dict_last;
while (addr != MAGICADDR_DICTFIRST) {
struct fh_word_s *w = fh_word_at(fh, addr);
if (!w) {
break;
}
if (0 == strncasecmp(name, w->name, wordlen) && w->name[wordlen] == 0) {
if (addr_out) {
*addr_out = addr;
@@ -377,61 +398,6 @@ enum fh_error fh_loop_unnest(struct fh_thread_s *fh)
return FH_OK;
}
/** Process a word read from input */
static 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 = 0;
if (FH_OK == fh_find_word(fh, name, wordlen, &wadr)) {
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);
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, (uint32_t) v));
} else {
/* interpret */
LOG("Interpret number: %ld", v);
TRY(ds_push(fh, (uint32_t) v));
}
return FH_OK;
}
/** Postpone a word */
enum fh_error fh_postpone_word(
@@ -449,91 +415,3 @@ enum fh_error fh_postpone_word(
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.echo && !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:
/* try to read a word */
end = strchr(rp, ' ');
if (end) {
length = end - rp; /* exclude the space */
} else {
length = strlen(rp);
}
ReadPos += length + 1;
/* eval a word */
//LOG("Handle \"%.*s\"", (int) length, rp);
TRY(fh_handle_ascii_word(fh, rp, length));
if (!end) {
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");
fh_setsubstate(fh, 0);
goto done; // just discard the rest
default:
LOGE("Bad substate %s", substatenames[fh->substate]);
}
}
done:
LOG("Line done.");
return FH_OK;
}
src/fh_see.c
+34 -16
View File
@@ -1,20 +1,26 @@
#include "forth.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "fh_print.h"
#include "forth_internal.h"
static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
{
if (!w) {
LOGE("NULL!");
return;
}
if (w->flags & WORDFLAG_WORD) {
if (w->handler == w_user_word) {
uint32_t execptr = w->param;
FHPRINT("Compiled word %s%s\n", w->name, (w->flags&WORDFLAG_IMMEDIATE) ? " IMMEDIATE" : "");
FHPRINT("Compiled word %s%s\n", w->name, (w->flags & WORDFLAG_IMMEDIATE) ? " IMMEDIATE" : "");
while (1) {
// make sure it's aligned
execptr = WORDALIGNED(execptr);
FHPRINT("0x%08x: ", execptr);
const struct fh_instruction_s *instr = fh_instr_at(fh, execptr);
if (!instr) {
LOGE("Word pointer out of bounds!");
return;
}
execptr += INSTR_SIZE;
uint32_t strl;
@@ -26,24 +32,36 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
case FH_INSTR_WORD:
w2 = fh_word_at(fh, instr->data);
FHPRINT("Call(word %s)\n", w2->name);
if (w2) {
FHPRINT("Call(word %s)\n", w2->name);
} else {
FHPRINT("Call(BAD ADDRESS!!! 0x%08x)\n", instr->data);
}
break;
case FH_INSTR_POSTPONED_WORD:
w2 = fh_word_at(fh, instr->data);
if (w2->name[0]) {
FHPRINT("Postpone(word %s)\n", w2->name);
if (w2) {
if (w2->name[0]) {
FHPRINT("Postpone(word %s)\n", w2->name);
} else {
FHPRINT("Postpone(word 0x%08x)\n", instr->data);
}
} else {
FHPRINT("Postpone(word 0x%08x)\n", instr->data);
FHPRINT("Postpone(BAD ADDRESS!!! 0x%08x)\n", instr->data);
}
break;
case FH_INSTR_TO:
w2 = fh_word_at(fh, instr->data);
if (w2->name[0]) {
FHPRINT("To(var %s)\n", w2->name);
if (w2) {
if (w2->name[0]) {
FHPRINT("To(var %s)\n", w2->name);
} else {
FHPRINT("To(var 0x%08x)\n", instr->data);
}
} else {
FHPRINT("To(var 0x%08x)\n", instr->data);
FHPRINT("To(BAD ADDRESS!!! 0x%08x)\n", instr->data);
}
break;
@@ -96,13 +114,13 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
FHPRINT("Built-in word %s\n", w->name);
};
} else if (w->flags & WORDFLAG_VARIABLE) {
FHPRINT("Variable %s, value %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
FHPRINT("Variable %s, value %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
} else if (w->flags & WORDFLAG_CONSTANT) {
FHPRINT("Constant %s, value %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
FHPRINT("Constant %s, value %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
} else if (w->flags & WORDFLAG_CREATED) {
FHPRINT("CREATE'd entry %s, param %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
FHPRINT("CREATE'd entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
} else {
FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
}
}
src/fh_stack.c
+19 -5
View File
@@ -1,8 +1,4 @@
#include "fh_error.h"
#include "fh_config.h"
#include "fh_runtime.h"
#include "fh_stack.h"
#include "fh_print.h"
#include "forth_internal.h"
// TODO stacks should grow down, not up!
@@ -86,6 +82,24 @@ enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out)
} \
} while(0)
enum fh_error ds_push_dw(struct fh_thread_s *fh, uint64_t in)
{
enum fh_error rv;
TRY(ds_push(fh, in & 0xFFFFFFFFULL));
TRY(ds_push(fh, (in & 0xFFFFFFFF00000000ULL) >> 32));
return FH_OK;
}
enum fh_error ds_pop_dw(struct fh_thread_s *fh, uint64_t *out)
{
enum fh_error rv;
uint32_t a, b;
TRY(ds_pop(fh, &a));
TRY(ds_pop(fh, &b));
*out = ((uint64_t)a << 32) | ((uint64_t)b);
return FH_OK;
}
/** Push to data stack */
enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in)
{
src/main.c
+3 -3
View File
@@ -5,8 +5,6 @@
#include <ctype.h>
#include "forth.h"
#include "fh_runtime.h"
#include "fh_print.h"
int main(int argc, char *argv[])
{
@@ -70,7 +68,9 @@ int main(int argc, char *argv[])
/* process input line by line */
int linecnt = 0;
char linebuf[MAXLINE];
FHPRINT("%s", prompt);
if (fh_globals.interactive) {
FHPRINT("%s", prompt);
}
while (fh.state != FH_STATE_SHUTDOWN && fgets(linebuf, MAXLINE, infile)) {
linecnt++;