big refactor and add DO-LOOP and DO-+LOOP and LEAVE

master
Ondřej Hruška 3 years ago
parent f74d157a7c
commit ef2e6943bd
Signed by: MightyPork
GPG Key ID: 2C5FD5035250423D
  1. 8
      CMakeLists.txt
  2. 6
      doloop.forth
  3. 29
      include/fh_builtins.h
  4. 2
      include/fh_mem.h
  5. 63
      include/fh_runtime.h
  6. 2
      include/fh_stack.h
  7. 1
      include/forth.h
  8. 1356
      src/fh_builtins.c
  9. 346
      src/fh_builtins_arith.c
  10. 236
      src/fh_builtins_control.c
  11. 137
      src/fh_builtins_mem.c
  12. 177
      src/fh_builtins_meta.c
  13. 260
      src/fh_builtins_stack.c
  14. 51
      src/fh_builtins_system.c
  15. 198
      src/fh_builtins_text.c
  16. 8
      src/fh_mem.c
  17. 200
      src/fh_runtime.c
  18. 106
      src/fh_see.c
  19. 11
      src/fh_stack.c

@ -6,10 +6,18 @@ set(CMAKE_C_STANDARD 99)
add_executable(forth add_executable(forth
src/main.c src/main.c
src/fh_builtins.c src/fh_builtins.c
src/fh_builtins_control.c
src/fh_builtins_stack.c
src/fh_builtins_arith.c
src/fh_builtins_meta.c
src/fh_builtins_mem.c
src/fh_builtins_system.c
src/fh_builtins_text.c
src/fh_runtime.c src/fh_runtime.c
src/fh_stack.c src/fh_stack.c
src/fh_mem.c src/fh_mem.c
src/fh_error.c src/fh_error.c
src/fh_see.c
) )
target_include_directories(forth PRIVATE include) target_include_directories(forth PRIVATE include)

@ -0,0 +1,6 @@
: test 10 0 DO I . I 5 = IF LEAVE THEN LOOP ;
see test
test

@ -7,6 +7,35 @@
#ifndef FORTH_FH_BUILTINS_H #ifndef FORTH_FH_BUILTINS_H
#define FORTH_FH_BUILTINS_H #define FORTH_FH_BUILTINS_H
struct name_and_handler {
const char *name;
word_exec_t handler;
bool immediate;
uint32_t param;
};
enum fh_error fh_register_words_from_array(struct fh_thread_s *fh, const struct name_and_handler *p);
enum fh_error register_builtin_words(struct fh_thread_s *fh); enum fh_error register_builtin_words(struct fh_thread_s *fh);
#define TOBOOL(a) ((a) == 0 ? 0 : 0xFFFFFFFF)
#define ENSURE_STATE(__state) do { \
if (fh->state != (__state)) { \
return FH_ERR_INVALID_STATE; \
} \
} while (0)
extern const struct name_and_handler fh_builtins_control[];
extern const struct name_and_handler fh_builtins_arith[];
extern const struct name_and_handler fh_builtins_stack[];
extern const struct name_and_handler fh_builtins_mem[];
extern const struct name_and_handler fh_builtins_meta[];
extern const struct name_and_handler fh_builtins_text[];
extern const struct name_and_handler fh_builtins_system[];
enum fh_error wp_const(struct fh_thread_s *fh, const struct fh_word_s *w);
enum fh_error wp_mul(struct fh_thread_s *fh, const struct fh_word_s *w);
enum fh_error wp_add(struct fh_thread_s *fh, const struct fh_word_s *w);
#endif //FORTH_FH_BUILTINS_H #endif //FORTH_FH_BUILTINS_H

@ -30,6 +30,8 @@ void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint3
enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len); enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len);
void fh_heap_copy(struct fh_thread_s *fh, uint32_t addr, uint32_t srcaddr, uint32_t len); void fh_heap_copy(struct fh_thread_s *fh, uint32_t addr, uint32_t srcaddr, uint32_t len);
enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fb_instruction_kind kind, uint32_t data);
char *fh_str_at(struct fh_thread_s *fh, uint32_t addr); 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); 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); struct fh_word_s *fh_word_at(struct fh_thread_s *fh, uint32_t addr);

@ -44,6 +44,21 @@ enum fb_instruction_kind {
/* Jump if zero */ /* Jump if zero */
FH_INSTR_JUMPZERO, FH_INSTR_JUMPZERO,
/* Loop exit */
FH_INSTR_LEAVE,
/* DO loop initializer */
FH_INSTR_DO,
/* ?DO short-circuiting loop */
FH_INSTR_DO_QUESTION,
/* Loop end instr */
FH_INSTR_LOOP,
/* Loop end instr with custom step */
FH_INSTR_LOOP_PLUS,
/* Postponed word */ /* Postponed word */
FH_INSTR_POSTPONED_WORD, FH_INSTR_POSTPONED_WORD,
}; };
@ -88,17 +103,25 @@ enum fh_substate {
FH_SUBSTATE_MAX, FH_SUBSTATE_MAX,
}; };
/** Marks a dictionary entry that is a word */
#define WORDFLAG_WORD 0x01
/** Indicates that this is a built-in instruction and not a word call */ /** Indicates that this is a built-in instruction and not a word call */
#define WORDFLAG_BUILTIN 0x01 #define WORDFLAG_BUILTIN 0x02
/** Indicates that this instruction should always be treated as interpreted */ /** Indicates that this instruction should always be treated as interpreted */
#define WORDFLAG_IMMEDIATE 0x02 #define WORDFLAG_IMMEDIATE 0x04
/** Variable or value stored in the dictionary */
#define WORDFLAG_VARIABLE 0x08
/** Constant with a value assigned */
#define WORDFLAG_CONSTANT 0x10
/** Word struct as they are stored in the dictionary */ /** Word struct as they are stored in the dictionary */
struct fh_word_s { struct fh_word_s {
/** Linked list pointer to previous word */ /** Linked list pointer to previous word */
uint32_t previous; uint32_t previous;
/** Word name */ /** Word name */
char name[MAX_NAME_LEN]; // XXX this wastes RAM! char name[MAX_NAME_LEN]; // XXX this wastes RAM!
/** /**
* Handler function. * Handler function.
* Builtin functions use pre-defined native handlers. * Builtin functions use pre-defined native handlers.
@ -106,7 +129,10 @@ struct fh_word_s {
* bytecode at 'start' address of the compile-memory area. * bytecode at 'start' address of the compile-memory area.
*/ */
word_exec_t handler; word_exec_t handler;
/** Word flags, using WORDFLAG_ defines */
uint32_t flags; uint32_t flags;
/** Start address in case of user words, or param for builtins */ /** Start address in case of user words, or param for builtins */
uint32_t param; uint32_t param;
}; };
@ -155,12 +181,21 @@ struct fh_thread_s {
/** The numeric base register */ /** The numeric base register */
uint32_t base; uint32_t base;
/** Loop variable I */
uint32_t loop_i;
/** Loop variable J */
uint32_t loop_j;
}; };
#define HEAP_END (HEAP_SIZE - WORDBUF_SIZE - INPUT_BUFFER_SIZE) #define HEAP_END (HEAP_SIZE - WORDBUF_SIZE - INPUT_BUFFER_SIZE)
#define WORDBUF_ADDR HEAP_END #define WORDBUF_ADDR HEAP_END
#define INPUTBUF_ADDR (HEAP_END + WORDBUF_SIZE) #define INPUTBUF_ADDR (HEAP_END + WORDBUF_SIZE)
enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue);
enum fh_error fh_loop_unnest(struct fh_thread_s *fh);
enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh); enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh);
void fh_setstate(struct fh_thread_s *fh, enum fh_state state, enum fh_substate substate); void fh_setstate(struct fh_thread_s *fh, enum fh_state state, enum fh_substate substate);
@ -178,6 +213,7 @@ enum fh_error fh_postpone_word(
size_t wordlen size_t wordlen
); );
/** Show disassembly of a dictionary word */
enum fh_error fh_see_word( enum fh_error fh_see_word(
struct fh_thread_s *fh, struct fh_thread_s *fh,
const char *name, const char *name,
@ -209,12 +245,23 @@ _Static_assert(WORDALIGNED(1024) == 1024, "word align");
if (FH_OK != (rv = (x))) return rv; \ if (FH_OK != (rv = (x))) return rv; \
} while (0) } while (0)
enum fh_error fh_handle_ascii_word( /**
struct fh_thread_s *fh, * Execute a dictionary word from a definition stored at the given address
const char *name, * @param fh
size_t wordlen * @param addr
); * @return
*/
enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr); enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr);
/**
* Find a word in the dict
*
* @param fh
* @param name - name, may be NUL terminated
* @param wordlen - length, use 0 for strlen
* @param addr_out the word address is output here, if given
* @return success
*/
enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t wordlen, uint32_t *addr_out);
#endif //FORTH_FH_RUNTIME_H #endif //FORTH_FH_RUNTIME_H

@ -18,6 +18,8 @@ static inline enum fh_error cs_peek_n(struct fh_thread_s *fh, uint32_t *out, int
return ds_peek_n(fh, out, n); return ds_peek_n(fh, out, n);
} }
enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n);
/** Peek top of data stack */ /** Peek top of data stack */
static inline enum fh_error ds_peek(struct fh_thread_s *fh, uint32_t *out) static inline enum fh_error ds_peek(struct fh_thread_s *fh, uint32_t *out)
{ {

@ -7,6 +7,7 @@
#ifndef FORTH_H #ifndef FORTH_H
#define FORTH_H #define FORTH_H
#include <stddef.h>
#include <stdint.h> #include <stdint.h>
#include <stdbool.h> #include <stdbool.h>

File diff suppressed because it is too large Load Diff

@ -0,0 +1,346 @@
#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "fh_stack.h"
#include "fh_print.h"
#include "fh_builtins.h"
static enum fh_error wp_setbase(struct fh_thread_s *fh, const struct fh_word_s *w)
{
fh_setbase(fh, w->param);
return FH_OK;
}
enum fh_error wp_const(struct fh_thread_s *fh, const struct fh_word_s *w)
{
enum fh_error rv;
TRY(ds_push(fh, w->param));
return FH_OK;
}
static enum fh_error w_plus(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));
TRY(ds_push(fh, a + b));
return FH_OK;
}
static enum fh_error w_minus(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_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));
TRY(ds_push(fh, a * b));
return FH_OK;
}
static enum fh_error w_and(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));
TRY(ds_push(fh, a & b));
return FH_OK;
}
static enum fh_error w_or(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));
TRY(ds_push(fh, a | b));
return FH_OK;
}
static enum fh_error w_xor(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));
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(a < 0)));
return FH_OK;
}
static enum fh_error w_zero_greater(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(a > 0)));
return FH_OK;
}
static enum fh_error w_zero_equals(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(a == 0)));
return FH_OK;
}
static enum fh_error w_zero_not_equals(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(a != 0)));
return FH_OK;
}
static enum fh_error w_less(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, TOBOOL(a < b)));
return FH_OK;
}
static enum fh_error w_greater(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, TOBOOL(a > b)));
return FH_OK;
}
static enum fh_error w_equals(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, TOBOOL(a == b)));
return FH_OK;
}
static enum fh_error w_not_equals(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, TOBOOL(a != b)));
return FH_OK;
}
enum fh_error wp_add(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));
return FH_OK;
}
enum fh_error wp_mul(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));
return FH_OK;
}
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));
return FH_OK;
}
static enum fh_error w_star_slash(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t a = 0, b = 0, c = 0;
TRY(ds_pop(fh, &c));
TRY(ds_pop(fh, &b));
TRY(ds_pop(fh, &a));
if (c == 0) {
return FH_ERR_DIV_BY_ZERO;
}
uint64_t v = ((uint64_t) a * (uint64_t) b) / (uint64_t) c;
TRY(ds_push(fh, (uint32_t) v));
return FH_OK;
}
static enum fh_error w_star_slash_mod(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t a = 0, b = 0, c = 0;
TRY(ds_pop(fh, &c));
TRY(ds_pop(fh, &b));
TRY(ds_pop(fh, &a));
if (c == 0) {
return FH_ERR_DIV_BY_ZERO;
}
uint64_t product = ((uint64_t) a * (uint64_t) b);
uint64_t v = product / (uint64_t) c;
uint64_t m = product % (uint64_t) c;
TRY(ds_push(fh, (uint32_t) m));
TRY(ds_push(fh, (uint32_t) v));
return FH_OK;
}
static enum fh_error w_slash(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));
if (b == 0) {
return FH_ERR_DIV_BY_ZERO;
}
TRY(ds_push(fh, a / b));
return FH_OK;
}
static enum fh_error w_abs(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 sa = (int32_t) a; // TODO is this right?
if (sa < 0) { sa = -sa; }
TRY(ds_push(fh, sa));
return FH_OK;
}
static enum fh_error w_invert(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));
return FH_OK;
}
static enum fh_error w_negate(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, (uint32_t) (-(uint32_t) a)));
return FH_OK;
}
static enum fh_error w_slash_mod(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));
if (b == 0) {
return FH_ERR_DIV_BY_ZERO;
}
uint32_t rem = a % b;
uint32_t div = a / b;
TRY(ds_push(fh, rem));
TRY(ds_push(fh, div));
return FH_OK;
}
const struct name_and_handler fh_builtins_arith[] = {
/* Arithmetics */
{"base", wp_const, 0, MAGICADDR_BASE},
{"decimal", wp_setbase, 0, 10},
{"hex", wp_setbase, 0, 16},
{"false", wp_const, 0, 0},
{"true", wp_const, 0, 0xFFFFFFFF},
{"+", w_plus, 0, 0},
{"-", w_minus, 0, 0},
{"*", w_star, 0, 0},
{"*/", w_star_slash, 0, 0},
{"*/mod", w_star_slash_mod, 0, 0},
{"or", w_or, 0, 0},
{"and", w_and, 0, 0},
{"xor", w_xor, 0, 0},
{"/", w_slash, 0, 0},
{"abs", w_abs, 0, 0},
{"/mod", w_slash_mod, 0, 0},
{"invert", w_invert, 0, 0},
{"negate", w_negate, 0, 0},
{"0<", w_zero_less, 0, 0},
{"0=", w_zero_equals, 0, 0},
{"0<>", w_zero_not_equals, 0, 0},
{"0>", w_zero_greater, 0, 0},
{"<", w_less, 0, 0},
{"=", w_equals, 0, 0},
{"<>", w_not_equals, 0, 0},
{">", w_greater, 0, 0},
{"1+", wp_add, 0, 1},
{"1-", wp_add, 0, -1},
{"2+", wp_add, 0, 2},
{"2-", wp_add, 0, -2},
{"2*", wp_mul, 0, 2},
{"2/", wp_div, 0, 2},
{ /* end marker */ }
};

@ -0,0 +1,236 @@
#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "fh_stack.h"
#include "fh_print.h"
#include "fh_builtins.h"
static enum fh_error w_recurse(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
TRY(fh_put_instr(fh, FH_INSTR_WORD, fh->dict_last));
return FH_OK;
}
static enum fh_error w_if(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
TRY(cs_push(fh, fh->here));
TRY(fh_put_instr(fh, FH_INSTR_JUMPZERO, MAGICADDR_UNRESOLVED));
return FH_OK;
}
static enum fh_error w_else(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
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) {
LOGE("IF-ELSE control stack corruption");
return FH_ERR_INTERNAL;
}
if_instr->data = fh->here + INSTR_SIZE;
TRY(cs_push(fh, fh->here));
TRY(fh_put_instr(fh, FH_INSTR_JUMP, MAGICADDR_UNRESOLVED));
return FH_OK;
}
static enum fh_error w_then(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
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) {
LOGE("IF-ELSE control stack corruption");
return FH_ERR_INTERNAL;
}
if_instr->data = fh->here;
return FH_OK;
}
static enum fh_error w_until(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
uint32_t destaddr = 0;
TRY(cs_pop(fh, &destaddr));
TRY(fh_put_instr(fh, FH_INSTR_JUMPZERO, destaddr));
return FH_OK;
}
static enum fh_error w_begin(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
TRY(cs_push(fh, fh->here)); /* dest */
return FH_OK;
}
static enum fh_error wp_do(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
TRY(fh_put_instr(fh, w->param ? FH_INSTR_DO_QUESTION : FH_INSTR_DO, MAGICADDR_UNRESOLVED));
// R will now contain: limit,index
TRY(cs_push(fh, fh->here)); // mark the start position (after init)
return FH_OK;
}
static enum fh_error wp_loop(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
struct fh_instruction_s *ii;
ENSURE_STATE(FH_STATE_COMPILE);
uint32_t loopendaddr = fh->here;
uint32_t startaddr;
TRY(cs_pop(fh, &startaddr));
TRY(fh_put_instr(fh, w->param ? FH_INSTR_LOOP_PLUS : FH_INSTR_LOOP, startaddr));
// after the end LOOP
uint32_t endaddr = fh->here;
// resolve ?DO dest
ii = fh_instr_at(fh, startaddr - INSTR_SIZE);
if (ii->kind == FH_INSTR_DO_QUESTION && ii->data == MAGICADDR_UNRESOLVED) {
ii->data = endaddr;
}
while (startaddr < loopendaddr) {
ii = fh_instr_at(fh, startaddr);
if (ii->kind == FH_INSTR_LEAVE && ii->data == MAGICADDR_UNRESOLVED) {
LOG("Resolve leave addr");
ii->data = endaddr;
}
// forward, skipping strings safely
if (ii->kind == FH_INSTR_TYPESTR || ii->kind == FH_INSTR_ALLOCSTR) {
startaddr += INSTR_SIZE + ii->data;
startaddr = WORDALIGNED(startaddr);
} else {
startaddr += INSTR_SIZE;
}
}
return FH_OK;
}
static enum fh_error w_leave(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
TRY(fh_put_instr(fh, FH_INSTR_LEAVE, MAGICADDR_UNRESOLVED));
return FH_OK;
}
static enum fh_error w_while(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
uint32_t destaddr = 0;
TRY(cs_pop(fh, &destaddr));
TRY(cs_push(fh, fh->here)); // orig
TRY(cs_push(fh, destaddr)); // dest
TRY(fh_put_instr(fh, FH_INSTR_JUMPZERO, MAGICADDR_UNRESOLVED));
return FH_OK;
}
static enum fh_error w_repeat(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
uint32_t origaddr = 0;
uint32_t destaddr = 0;
TRY(cs_pop(fh, &destaddr));
TRY(cs_pop(fh, &origaddr));
struct fh_instruction_s *branch_instr = fh_instr_at(fh, origaddr);
if (branch_instr->data != MAGICADDR_UNRESOLVED) {
LOGE("REPEAT control stack corruption");
return FH_ERR_INTERNAL;
}
branch_instr->data = fh->here + INSTR_SIZE;
TRY(fh_put_instr(fh, FH_INSTR_JUMP, destaddr));
return FH_OK;
}
static enum fh_error w_again(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
uint32_t destaddr = 0;
TRY(cs_pop(fh, &destaddr));
TRY(fh_put_instr(fh, FH_INSTR_JUMP, destaddr));
return FH_OK;
}
static enum fh_error wp_ij(struct fh_thread_s *fh, const struct fh_word_s *w)
{
enum fh_error rv;
TRY(ds_push(fh, w->param ? fh->loop_j : fh->loop_i));
return FH_OK;
}
const struct name_and_handler fh_builtins_control[] = {
{"i", wp_ij, 0, 0},
{"j", wp_ij, 0, 1},
{"if", w_if, 1, 0},
{"else", w_else, 1, 0},
{"then", w_then, 1, 0},
{"recurse", w_recurse, 1, 0},
{"do", wp_do, 1, 0},
{"?do", wp_do, 1, 1},
{"loop", wp_loop, 1, 0},
{"leave", w_leave, 1, 0},
{"loop+", wp_loop, 1, 1},
{"begin", w_begin, 1, 0},
{"while", w_while, 1, 0},
{"repeat", w_repeat, 1, 0},
{"again", w_again, 1, 0},
{"until", w_until, 1, 0},
{ /* end marker */ }
};

@ -0,0 +1,137 @@
#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "fh_stack.h"
#include "fh_print.h"
#include "fh_builtins.h"
static enum fh_error w_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t addr = 0;
TRY(ds_pop(fh, &addr));
uint32_t val = 0;
TRY(fh_fetch(fh, addr, &val));
TRY(ds_push(fh, val));
return FH_OK;
}
static enum fh_error w_store(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t addr = 0;
TRY(ds_pop(fh, &addr));
uint32_t val = 0;
TRY(ds_pop(fh, &val));
TRY(fh_store(fh, addr, val));
return FH_OK;
}
static enum fh_error w_two_store(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t addr = 0;
TRY(ds_pop(fh, &addr));
uint32_t a = 0, b = 0;
TRY(ds_pop(fh, &a));
TRY(ds_pop(fh, &b));
TRY(fh_store(fh, addr, a));
TRY(fh_store(fh, addr + CELL, b));
return FH_OK;
}
static enum fh_error w_two_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t addr = 0;
TRY(ds_pop(fh, &addr));
uint32_t a = 0, b = 0;
TRY(fh_fetch(fh, addr, &a));
TRY(fh_fetch(fh, addr + CELL, &b));
TRY(ds_push(fh, b));
TRY(ds_push(fh, a));
return FH_OK;
}
static enum fh_error w_aligned(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t addr = 0;
TRY(ds_pop(fh, &addr));
TRY(ds_push(fh, WORDALIGNED(addr)));
return FH_OK;
}
static enum fh_error w_allot(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t count = 0;
TRY(ds_pop(fh, &count));
TRY(fh_heap_reserve(fh, count, NULL));
return FH_OK;
}
static enum fh_error w_comma(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
if (fh->here & 3) {
LOGE("HERE not aligned before 'comma'");
return FH_ERR_ILLEGAL_STORE;
}
uint32_t value = 0;
TRY(ds_pop(fh, &value));
TRY(fh_heap_put(fh, &value, CELL));
return FH_OK;
}
static enum fh_error w_align(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
fh->here = WORDALIGNED(fh->here);
return FH_OK;
}
static enum fh_error w_pad(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t addr = fh->here + PAD_OFFSET;
if (addr + 84 >= HEAP_END) {
LOGE("Heap overflow, PAD is too small!");
return FH_ERR_HEAP_FULL;
}
TRY(ds_push(fh, addr));
return FH_OK;
}
const struct name_and_handler fh_builtins_mem[] = {
{"chars", wp_mul, 0, 1},
{"char+", wp_add, 0, 1},
{"cells", wp_mul, 0, CELL},
{"cell+", wp_add, 0, CELL},
{"@", w_fetch, 0, 0},
{"!", w_store, 0, 0},
{"2!", w_two_store, 0, 0},
{"2@", w_two_fetch, 0, 0},
{"aligned", w_aligned, 0, 0},
{"allot", w_allot, 0, 0},
{"align", w_align, 0, 0},
{",", w_comma, 0, 0},
{"here", wp_const, 0, MAGICADDR_HERE},
{"pad", w_pad, 0, 0},
{ /* end marker */ }
};

@ -0,0 +1,177 @@
#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"
static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_INTERPRET);
char *wordname = NULL;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
LOG("Name: %.*s", namelen, wordname);
fh_setstate(fh, FH_STATE_COMPILE, 0);
uint32_t ptr;
TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
struct fh_word_s *new_word = fh_word_at(fh, ptr);
new_word->previous = fh->dict_last;
new_word->param = fh->here;
new_word->handler = w_user_word;
strncpy(new_word->name, wordname, namelen);
new_word->name[namelen] = 0;
new_word->flags = WORDFLAG_WORD;
fh->dict_last = ptr;
return FH_OK;
}
static enum fh_error w_forget(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_INTERPRET);
char *wordname = NULL;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
LOG("Name to forget: %.*s", namelen, wordname);
uint32_t addr;
TRY(fh_find_word(fh, wordname, namelen, &addr));
struct fh_word_s *removedword = fh_word_at(fh, addr);
fh->dict_last = removedword->previous;
return FH_OK;
}
static enum fh_error w_postpone(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
char *wordname;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
TRY(fh_postpone_word(fh, wordname, namelen));
return FH_OK;
}
static enum fh_error w_leftbracket(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
ENSURE_STATE(FH_STATE_COMPILE);
fh_setstate(fh, FH_STATE_INTERPRET, 0);
return FH_OK;
}
static enum fh_error w_rightbracket(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
ENSURE_STATE(FH_STATE_INTERPRET);
fh_setstate(fh, FH_STATE_COMPILE, 0);
return FH_OK;
}
static enum fh_error w_literal(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
uint32_t val;
TRY(ds_pop(fh, &val));
TRY(fh_put_instr(fh, FH_INSTR_NUMBER, val));
return FH_OK;
}
static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s *w0)
{
(void) w0;
enum fh_error rv;
ENSURE_STATE(FH_STATE_COMPILE);
TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 0));
/* Return to interpret state */
fh_setstate(fh, FH_STATE_INTERPRET, 0);
// XXX if there was another definition previously and it was used in some other compiled function,
// that old implementation will still be called.
return FH_OK;
}
static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
if (fh->dict_last == 0) {
LOGE("Dict is empty, cannot modify previous word!");
return FH_ERR_INVALID_STATE;
}
fh_word_at(fh, fh->dict_last)->flags |= WORDFLAG_IMMEDIATE;
return FH_OK;
}
static enum fh_error w_backslash(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
fh_setsubstate(fh, FH_SUBSTATE_LINE_COMMENT);
return FH_OK;
}
static enum fh_error w_paren(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
fh_setsubstate(fh, FH_SUBSTATE_PAREN_COMMENT);
return FH_OK;
}
static enum fh_error w_char(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
char *wordname = NULL;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
TRY(ds_push(fh, (char) *wordname));
return FH_OK;
}
const struct name_and_handler fh_builtins_meta[] = {
{":", w_colon, 0, 0},
{";", w_semicolon, 1, 0},
{"forget", w_forget, 1, 0},
{"\\", w_backslash, 1, 0}, // line comment
{"(", w_paren, 1, 0}, // enclosed comment
{"immediate", w_immediate, 0, 0},
{"postpone", w_postpone, 1, 0},
{"[", w_leftbracket, 1, 0},
{"]", w_rightbracket, 1, 0},
{"literal", w_literal, 1, 0},
{"char", w_char, 0, 0},
{"[char]", w_char, 1, 0},
{ /* end marker */ }
};

@ -0,0 +1,260 @@
#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_stack.h"
#include "fh_builtins.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 */ }
};

@ -0,0 +1,51 @@
#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"
static enum fh_error w_depth(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
TRY(ds_push(fh, fh->data_stack_top));
return FH_OK;
}
static enum fh_error w_unused(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
TRY(ds_push(fh, HEAP_SIZE - fh->here));
return FH_OK;
}
// 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);
return FH_OK;
}
static enum fh_error w_bye(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
fh_setstate(fh, FH_STATE_SHUTDOWN, 0);
return FH_OK;
}
const struct name_and_handler fh_builtins_system[] = {
{"depth", w_depth, 0, 0},
{"unused", w_unused, 0, 0},
{"reset", w_reset, 1, 0},
{"bye", w_bye, 0, 0},
{ /* end marker */ }
};

@ -0,0 +1,198 @@
#include "fh_error.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "fh_stack.h"
#include "fh_print.h"
#include "fh_builtins.h"
/**
* Encode a code point using UTF-8
*
* Copied from ESPTERM source
*
* @param out - output buffer (min 4 characters), will be 0-terminated if shorten than 4
* @param utf - code point 0-0x10FFFF
* @return number of bytes on success, 0 on failure (also produces U+FFFD, which uses 3 bytes)
*/
static int utf8_encode(char *out, uint32_t utf)
{
if (utf <= 0x7F) {
// Plain ASCII
out[0] = (char) utf;
out[1] = 0;
return 1;
} else if (utf <= 0x07FF) {
// 2-byte unicode
out[0] = (char) (((utf >> 6) & 0x1F) | 0xC0);
out[1] = (char) (((utf >> 0) & 0x3F) | 0x80);
out[2] = 0;
return 2;
} else if (utf <= 0xFFFF) {
// 3-byte unicode
out[0] = (char) (((utf >> 12) & 0x0F) | 0xE0);
out[1] = (char) (((utf >> 6) & 0x3F) | 0x80);
out[2] = (char) (((utf >> 0) & 0x3F) | 0x80);
out[3] = 0;
return 3;
} else if (utf <= 0x10FFFF) {
// 4-byte unicode
out[0] = (char) (((utf >> 18) & 0x07) | 0xF0);
out[1] = (char) (((utf >> 12) & 0x3F) | 0x80);
out[2] = (char) (((utf >> 6) & 0x3F) | 0x80);
out[3] = (char) (((utf >> 0) & 0x3F) | 0x80);
// out[4] = 0;
return 4;
} else {
// error - use replacement character
out[0] = (char) 0xEF;
out[1] = (char) 0xBF;
out[2] = (char) 0xBD;
out[3] = 0;
return 0;
}
}
static enum fh_error w_dot(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));
FHPRINT("%d ", (int32_t) a);
return FH_OK;
}
static enum fh_error w_type(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
uint32_t count = 0, addr = 0;
LOG("Get count,addr");
TRY(ds_pop(fh, &count));
TRY(ds_pop(fh, &addr));
FHPRINT("%.*s", count, fh_str_at(fh, addr));
return FH_OK;
}
static enum fh_error wp_putc(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) fh;
FHPRINT("%c", w->param);
return FH_OK;
}
static enum fh_error w_debug_dump(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
(void) fh;
FHPRINT("DS ");
for (int i = 0; i < fh->data_stack_top; i++) {
FHPRINT("%d ", fh->data_stack[i]);
}
FHPRINT("\nRS ");
for (int i = 0; i < fh->return_stack_top; i++) {
FHPRINT("%d ", fh->return_stack[i]);
}
FHPRINT("\n");
return FH_OK;
}
static enum fh_error w_emit(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));
char buf[5];
int num = utf8_encode(buf, a);
FHPRINT("%.*s", num, buf);
return FH_OK;
}
static enum fh_error w_see(struct fh_thread_s *fh, const struct fh_word_s *w)
{
enum fh_error rv;
char *wordname;
size_t namelen = 0;
fh_input_consume_spaces(fh);
TRY(fh_input_read_word(fh, &wordname, &namelen));
TRY(fh_see_word(fh, wordname, namelen));
return FH_OK;
}
static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
size_t len;
uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE);
/* read the string straight into HEAP */
fh_input_consume_spaces(fh);
char *start = (char *) &fh->heap[addr];
TRY(fh_input_read_quotedstring(fh, w->param == 1, start, HEAP_END - addr, &len));
fh->here = WORDALIGNED(addr + len);
struct fh_instruction_s instr;
if (fh->state == FH_STATE_INTERPRET) {
LOG("Interpret a string alloc: \"%.*s\"", len, start);
TRY(ds_push(fh, addr));
TRY(ds_push(fh, len));
} else {
LOG("Compile a string: \"%.*s\"", len, start);
instr_init(&instr, FH_INSTR_ALLOCSTR, len);
fh_heap_write(fh, addr - INSTR_SIZE, &instr, INSTR_SIZE);
}
return FH_OK;
}
static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
{
(void) w;
enum fh_error rv;
size_t len;
uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE);
/* read the string straight into HEAP, but don't advance the heap pointer, so the string is immediately discarded again */
fh_input_consume_spaces(fh);
char *start = (char *) &fh->heap[addr];
TRY(fh_input_read_quotedstring(fh, w->param == 1, start, HEAP_END - addr, &len));
struct fh_instruction_s instr;
if (fh->state == FH_STATE_INTERPRET) {
FHPRINT("%.*s", (int) len, start);
} else {
LOG("Compile a string: \"%.*s\"", len, start);
instr_init(&instr, FH_INSTR_TYPESTR, len);
fh_heap_write(fh, addr - INSTR_SIZE, &instr, INSTR_SIZE);
fh->here = WORDALIGNED(addr + len);
}
return FH_OK;
}
const struct name_and_handler fh_builtins_text[] = {
{"s\"", w_s_quote, 1, 0},
{"s\\\"", w_s_quote, 1, 1}, // escaped
{".\"", w_dot_quote, 1, 0},
{".\\\"", w_dot_quote, 1, 1}, // escaped, this is non-standard
{".", w_dot, 0, 0},
{"type", w_type, 0, 0},
{"cr", wp_putc, 0, '\n'},
{"space", wp_putc, 0, ' '},
{"bl", wp_const, 0, ' '},
{"??", w_debug_dump, 0, 0},
{"emit", w_emit, 0, 0},
{"see", w_see, 0, 0},
{ /* end marker */ }
};

@ -142,6 +142,14 @@ void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint3
memcpy(&fh->heap[addr], src, len); memcpy(&fh->heap[addr], src, len);
} }
enum fh_error fh_put_instr(struct fh_thread_s *fh, enum fb_instruction_kind kind, uint32_t data) {
struct fh_instruction_s instr = {
.kind = kind,
.data = data,
};
return fh_heap_put(fh, &instr, INSTR_SIZE);
}
/** Allocate heap region and write bytes to it */ /** Allocate heap region and write bytes to it */
enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len) enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len)
{ {

@ -218,6 +218,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
uint32_t strl; uint32_t strl;
uint32_t val; uint32_t val;
uint32_t addr = 0; uint32_t addr = 0;
uint32_t limit, index, index0;
struct fh_instruction_s instr2; struct fh_instruction_s instr2;
switch (instr->kind) { switch (instr->kind) {
@ -233,8 +234,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
TRY(w2->handler(fh, w2)); TRY(w2->handler(fh, w2));
} else { } else {
LOG("Add postponed word: %s", w2->name); LOG("Add postponed word: %s", w2->name);
instr_init(&instr2, FH_INSTR_WORD, instr->data); TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data));
TRY(fh_heap_put(fh, &instr, INSTR_SIZE));
} }
} else { } else {
LOGE("Postpone in interpret mode!"); LOGE("Postpone in interpret mode!");
@ -282,6 +282,63 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
fh->execptr = instr->data; fh->execptr = instr->data;
goto instr; goto instr;
case FH_INSTR_DO:
TRY(ds_pop(fh, &index));
TRY(ds_pop(fh, &limit)); // just make sure it exists
TRY(fh_loop_nest(fh, index));
TRY(rs_push(fh, limit));
goto instr;
case FH_INSTR_DO_QUESTION:
if (instr->data == MAGICADDR_UNRESOLVED) {
LOGE("Encountered unresolved jump!");
goto end;
}
TRY(ds_pop(fh, &index));
TRY(ds_pop(fh, &limit));
if (index == limit) {
// jump to end
fh->execptr = instr->data;
} else {
TRY(fh_loop_nest(fh, index));
TRY(rs_push(fh, limit));
}
goto instr;
case FH_INSTR_LOOP_PLUS:
TRY(ds_pop(fh, &val));
// fall-through
case FH_INSTR_LOOP:
if (instr->kind == FH_INSTR_LOOP) {
val = 1;
}
// R: index,limit
TRY(rs_peek(fh, &limit));
index0 = fh->loop_i;
fh->loop_i += val;
if (index0 < limit == fh->loop_i < limit) { // boundary not crossed, continue
fh->execptr = instr->data; // go to beginning
} else {
// end of loop
TRY(rs_pop(fh, &limit));
TRY(fh_loop_unnest(fh));
}
goto instr;
case FH_INSTR_LEAVE:
if (instr->data == MAGICADDR_UNRESOLVED) {
LOGE("Encountered unresolved jump!");
goto end;
}
TRY(rs_pop(fh, &limit));
TRY(fh_loop_unnest(fh));
fh->execptr = instr->data;
goto instr;
/* special case for strings stored in compile memory */ /* special case for strings stored in compile memory */
case FH_INSTR_ALLOCSTR: case FH_INSTR_ALLOCSTR:
case FH_INSTR_TYPESTR: case FH_INSTR_TYPESTR:
@ -336,18 +393,20 @@ enum fh_error fh_handle_word(struct fh_thread_s *fh, uint32_t addr)
struct fh_word_s *w = fh_word_at(fh, addr); struct fh_word_s *w = fh_word_at(fh, addr);
if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) { if (fh->state == FH_STATE_COMPILE && 0 == (w->flags & WORDFLAG_IMMEDIATE)) {
LOG("Compile word call: %s", w->name); LOG("Compile word call: %s", w->name);
instr_init(&instr, FH_INSTR_WORD, addr); TRY(fh_put_instr(fh, FH_INSTR_WORD, addr));
TRY(fh_heap_put(fh, &instr, INSTR_SIZE));
} else { } else {
/* interpret or immediate in compiled code */ /* interpret or immediate in compiled code */
LOG("Run word: %s", w->name); LOG("Run word: %s (state=%d)", w->name, fh->state);
TRY(w->handler(fh, w)); TRY(w->handler(fh, w));
} }
return FH_OK; 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) enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t wordlen, uint32_t *addr_out)
{ {
if (wordlen == 0) {
wordlen = strlen(name);
}
uint32_t addr = fh->dict_last; uint32_t addr = fh->dict_last;
while (addr != MAGICADDR_DICTFIRST) { while (addr != MAGICADDR_DICTFIRST) {
struct fh_word_s *w = fh_word_at(fh, addr); struct fh_word_s *w = fh_word_at(fh, addr);
@ -355,15 +414,34 @@ static struct fh_word_s *find_word(struct fh_thread_s *fh, const char *name, con
if (addr_out) { if (addr_out) {
*addr_out = addr; *addr_out = addr;
} }
return w; return FH_OK;
} }
addr = w->previous; addr = w->previous;
} }
return NULL; // no log message, this can be OK - e.g. parsing a number
LOG("fail to find word %.*s", wordlen, name);
return FH_ERR_UNKNOWN_WORD;
}
enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue)
{
enum fh_error rv;
TRY(rs_push(fh, fh->loop_j));
fh->loop_j = fh->loop_i;
fh->loop_i = indexvalue;
return FH_OK;
}
enum fh_error fh_loop_unnest(struct fh_thread_s *fh)
{
enum fh_error rv;
fh->loop_i = fh->loop_j;
TRY(rs_pop(fh, &fh->loop_j));
return FH_OK;
} }
/** Process a word read from input */ /** Process a word read from input */
enum fh_error fh_handle_ascii_word( static enum fh_error fh_handle_ascii_word(
struct fh_thread_s *fh, struct fh_thread_s *fh,
const char *name, const char *name,
const size_t wordlen const size_t wordlen
@ -376,9 +454,8 @@ enum fh_error fh_handle_ascii_word(
/* First, try if it's a known word */ /* First, try if it's a known word */
uint32_t wadr = MAGICADDR_UNRESOLVED; uint32_t wadr = 0;
find_word(fh, name, wordlen, &wadr); if (FH_OK == fh_find_word(fh, name, wordlen, &wadr)) {
if (wadr != MAGICADDR_UNRESOLVED) {
TRY(fh_handle_word(fh, wadr)); TRY(fh_handle_word(fh, wadr));
return FH_OK; return FH_OK;
} }
@ -408,8 +485,7 @@ enum fh_error fh_handle_ascii_word(
struct fh_instruction_s instr; struct fh_instruction_s instr;
if (fh->state == FH_STATE_COMPILE) { if (fh->state == FH_STATE_COMPILE) {
LOG("Compile number: %ld", v); LOG("Compile number: %ld", v);
instr_init(&instr, FH_INSTR_NUMBER, (uint32_t) v); TRY(fh_put_instr(fh, FH_INSTR_NUMBER, (uint32_t) v));
TRY(fh_heap_put(fh, &instr, INSTR_SIZE));
} else { } else {
/* interpret */ /* interpret */
LOG("Interpret number: %ld", v); LOG("Interpret number: %ld", v);
@ -419,89 +495,6 @@ enum fh_error fh_handle_ascii_word(
return FH_OK; 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 */
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 */ /** Postpone a word */
enum fh_error fh_postpone_word( enum fh_error fh_postpone_word(
@ -510,17 +503,12 @@ enum fh_error fh_postpone_word(
const size_t wordlen const size_t wordlen
) )
{ {
enum fh_error rv;
uint32_t wadr; uint32_t wadr;
struct fh_word_s *w = find_word(fh, name, wordlen, &wadr); TRY(fh_find_word(fh, name, wordlen, &wadr));
if (!w) {
return FH_ERR_UNKNOWN_WORD;
}
enum fh_error rv; LOG("Postpone word");
struct fh_instruction_s instr; TRY(fh_put_instr(fh, FH_INSTR_POSTPONED_WORD, wadr));
LOG("Postpone %s", w->name);
instr_init(&instr, FH_INSTR_POSTPONED_WORD, wadr);
TRY(fh_heap_put(fh, &instr, INSTR_SIZE));
return FH_OK; return FH_OK;
} }

@ -0,0 +1,106 @@
#include "forth.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "fh_print.h"
static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
{
if (w->flags & WORDFLAG_WORD) {
if (w->handler == w_user_word) {
uint32_t execptr = w->param;
FHPRINT("Compiled word %s\n", w->name);
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);
execptr += INSTR_SIZE;
uint32_t strl;
const struct fh_word_s *w2;
switch (instr->kind) {
case FH_INSTR_NUMBER:
FHPRINT("Number(%d)\n", instr->data);
break;
case FH_INSTR_WORD:
w2 = fh_word_at(fh, instr->data);
FHPRINT("Call(word %s)\n", w2->name);
break;
case FH_INSTR_POSTPONED_WORD:
w2 = fh_word_at(fh, instr->data);
if (w2->name[0]) {
FHPRINT("Postpone(word %s)\n", w2->name);
} else {
FHPRINT("Postpone(word 0x%08x)\n", instr->data);
}
break;
case FH_INSTR_JUMPZERO:
FHPRINT("JumpIfZero(dest 0x%08x)\n", instr->data);
break;
case FH_INSTR_JUMP:
FHPRINT("Jump(dest 0x%08x)\n", instr->data);
break;
case FH_INSTR_DO:
FHPRINT("DO\n");
break;
case FH_INSTR_DO_QUESTION:
FHPRINT("DO?(end 0x%08x)\n", instr->data);
break;
case FH_INSTR_LOOP:
FHPRINT("LOOP(start 0x%08x)\n", instr->data);
break;
case FH_INSTR_LOOP_PLUS:
FHPRINT("LOOP+(start 0x%08x)\n", instr->data);
break;
/* 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;
}
break;
case FH_INSTR_ENDWORD:
FHPRINT("END\n");
return;
default:
FHPRINT("Unknown(kind 0x%08x, data 0x%08x)\n", instr->kind, instr->data);
}
}
} else if (w->flags & WORDFLAG_VARIABLE) {
FHPRINT("Variable %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
} else if (w->flags & WORDFLAG_CONSTANT) {
FHPRINT("Constant %s = %d (0x%08x)\n", w->name, (int32_t)w->param, w->param);
}
}
}
/** Decompile a word */
enum fh_error fh_see_word(
struct fh_thread_s *fh,
const char *name,
const size_t wordlen
)
{
enum fh_error rv;
uint32_t addr;
TRY(fh_find_word(fh, name, wordlen, &addr));
show_word(fh, fh_word_at(fh, addr));
return FH_OK;
}

@ -44,6 +44,17 @@ enum fh_error rs_peek_n(struct fh_thread_s *fh, uint32_t *out, int n)
return FH_OK; return FH_OK;
} }
/** Replace value on return stack */
enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n)
{
if (fh->return_stack_top <= n) {
LOG("RS peek_n UNDERFLOW");
return FH_ERR_RS_UNDERFLOW;
}
fh->return_stack[fh->return_stack_top - 1 - n] = value;
return FH_OK;
}
/** Pop from data stack */ /** Pop from data stack */
enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out) enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out)
{ {

Loading…
Cancel
Save