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
README.md
+7 -9
View File
@@ -44,15 +44,15 @@ Implementation status
*(this section may be outdated)*
Implemented:
Implemented (some may be wrong, like `FM/MOD`):
```
CORE:
! ' ( * */ */MOD + +! +LOOP , - . ." / /mod 0< 0= 1+ 1- 2! 2* 2/ 2@ 2DROP 2DUP 2OVER 2SWAP
: ; < = > >IN >R ?DUP @ ABORT ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL CELL CELL+ CELLS CHAR CHAR+
CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DROP DUP ELSE EMIT ENVIRONMENT? EXECUTE EXIT FIND
HERE I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP MOD NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE
REPEAT ROT S" SOURCE SPACE SWAP THEN TYPE U< UNTIL VARIABLE WHILE WORD XOR [ ['] [CHAR] ]
: ; < = > >IN >R ?DUP @ ABORT ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+
CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DROP DUP ELSE EMIT ENVIRONMENT? EXECUTE EXIT FM/MOD FIND
HERE I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE
REPEAT ROT RSHIFT S>D S" SM/REM SOURCE SPACE STATE SWAP THEN TYPE U< UNTIL UM* UM/MOD UNLOOP VARIABLE WHILE WORD XOR [ ['] [CHAR] ]
CORE-EXT:
.( 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN FALSE HEX NIP PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE
@@ -64,13 +64,11 @@ FORGET SEE BYE
Missing:
basically, CASE-OF, pictured numbers, some specialty math stuff, working with characters, the more
weird metaprogramming things, and manipulating the input buffer.
basically, CASE-OF, pictured numbers, keyboard input, some weirder metaprogramming things, manipulating the input buffer.
```
CORE:
# #> #S <# >BODY >NUMBER ABORT" ACCEPT C! C, C@ DOES> EVALUATE FILL FM/MOD HOLD KEY LSHIFY M* MAX
MIN MOVE RSHIFT S>D SIGN SM/REM SPACES STATE U. UM* UM/MOD UNLOOP
# #> #S <# >BODY >NUMBER ABORT" ACCEPT DOES> EVALUATE FILL HOLD KEY MOVE SIGN SPACES U.
CORE-EXT:
.R :NONAME ACTION-OF BUFFER: C" CASE COMPILE, DEFER DEFER! DEFER@ ENDCASE ENDOF ERASE HOLDS IS
include/fh_config.h
+13
View File
@@ -19,4 +19,17 @@
#define CELL 4
#define HEAP_END (HEAP_SIZE - WORDBUF_SIZE - INPUT_BUFFER_SIZE)
#define WORDBUF_ADDR HEAP_END
#define INPUTBUF_ADDR (HEAP_END + WORDBUF_SIZE)
// SFR and magic addresses are "negative"
#define MAGICADDR_EXEC_INTERACTIVE 0xFFFFFFFFULL
#define MAGICADDR_DICTFIRST 0xFFFFd1c7ULL
#define MAGICADDR_BASE 0xFFFFBA5EULL
#define MAGICADDR_HERE 0xFFFF4E7EULL
#define MAGICADDR_STATE 0xFFFF57a7ULL
#define MAGICADDR_INPTR 0xFFFFF175ULL
#define MAGICADDR_UNRESOLVED 0xFFFFFBADULL
#endif //FORTH_FH_CONFIG_H
include/fh_error.h
+1 -1
View File
@@ -25,7 +25,7 @@ enum fh_error {
FH_ERR_UNKNOWN_WORD,
FH_ERR_ILLEGAL_FETCH,
FH_ERR_ILLEGAL_STORE,
FH_ERR_DIV_BY_ZERO,
FH_ERR_ARITH,
FH_ERR_SYNTAX,
FH_ERR_NOT_APPLICABLE,
FH_ERR_MAX,
include/fh_helpers.h
+36
View File
@@ -0,0 +1,36 @@
/**
* Helper macros
*
* Created on 2021/11/17.
*/
#ifndef FORTH_FH_MACROS_H
#define FORTH_FH_MACROS_H
/**
* strncasecmp with guard against prefix match
*
* a - input string
* b - example string with terminator
* n - len of input string
*/
#define EQ(a, b, n) (0 == strncasecmp((a), (b), (n)) && (b)[(n)]==0)
/** Get a value rounded up to multiple of word size */
#define WORDALIGNED(var) (((var) + 3) & ~3)
_Static_assert(WORDALIGNED(0) == 0, "word align");
_Static_assert(WORDALIGNED(1) == 4, "word align");
_Static_assert(WORDALIGNED(2) == 4, "word align");
_Static_assert(WORDALIGNED(3) == 4, "word align");
_Static_assert(WORDALIGNED(4) == 4, "word align");
_Static_assert(WORDALIGNED(5) == 8, "word align");
_Static_assert(WORDALIGNED(1023) == 1024, "word align");
_Static_assert(WORDALIGNED(1024) == 1024, "word align");
#define TRY(x) \
do { \
if (FH_OK != (rv = (x))) return rv; \
} while (0)
#endif //FORTH_FH_MACROS_H
include/fh_parse.h
+6 -3
View File
@@ -7,15 +7,18 @@
#ifndef FORTH_FH_PARSE_H
#define FORTH_FH_PARSE_H
typedef bool (*chartest_t)(char c, void* param);
typedef bool (*chartest_t)(char c, void *param);
void fh_input_consume_matching(struct fh_thread_s *fh, chartest_t test, void* param);
void fh_input_consume_matching(struct fh_thread_s *fh, chartest_t test, void *param);
void fh_input_consume_spaces(struct fh_thread_s *fh);
enum fh_error fh_input_read_delimited(struct fh_thread_s *fh, char **out, size_t *len, chartest_t test, void* param);
enum fh_error fh_input_read_delimited(struct fh_thread_s *fh, char **out, size_t *len, chartest_t test, void *param);
enum fh_error fh_input_read_word(struct fh_thread_s *fh, char **out, size_t *len);
enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, char *outbuf, size_t capacity, size_t *out_len);
enum fh_error fh_handle_ascii_word(struct fh_thread_s *fh, const char *name, size_t wordlen);
#endif //FORTH_FH_PARSE_H
include/fh_print.h
-5
View File
@@ -7,11 +7,6 @@
#ifndef FORTH_FH_PRINT_H
#define FORTH_FH_PRINT_H
/* for printing */
#include <stdlib.h>
#include <stdio.h>
#include "fh_globals.h"
/* logging */
#define LOG(format, ...) do { if(fh_globals.verbose) { fprintf(stderr, format "\n", ##__VA_ARGS__); } } while (0)
#define LOGI(format, ...) fprintf(stderr, "\x1b[32m" format "\x1b[m\n", ##__VA_ARGS__)
include/fh_runtime.h
+10 -40
View File
@@ -78,12 +78,6 @@ struct fh_instruction_s {
uint32_t data;
};
static inline void instr_init(struct fh_instruction_s *instr, enum fh_instruction_kind kind, uint32_t data)
{
instr->kind = kind;
instr->data = data;
}
#define INSTR_SIZE (sizeof(struct fh_instruction_s))
_Static_assert(sizeof(struct fh_instruction_s) % 4 == 0, "Instruction struct is aligned");
@@ -107,9 +101,12 @@ enum fh_substate {
FH_SUBSTATE_PAREN_COMMENT,
FH_SUBSTATE_LINE_COMMENT,
FH_SUBSTATE_EXIT,
FH_SUBSTATE_SKIP_IF,
FH_SUBSTATE_MAX,
};
extern const char *substatenames[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 */
@@ -147,11 +144,8 @@ struct fh_word_s {
/** Word name */
char name[MAX_NAME_LEN]; // XXX this wastes RAM!
};
#define MAGICADDR_DICTFIRST 0xFFFFFFFFULL
#define DICTWORD_SIZE sizeof(struct fh_word_s)
/**
@@ -201,11 +195,10 @@ struct fh_thread_s {
/** Loop variable J */
uint32_t loop_j;
};
#define HEAP_END (HEAP_SIZE - WORDBUF_SIZE - INPUT_BUFFER_SIZE)
#define WORDBUF_ADDR HEAP_END
#define INPUTBUF_ADDR (HEAP_END + WORDBUF_SIZE)
/** Nesting level of [if] */
uint32_t parse_if_level;
};
enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue);
@@ -232,33 +225,6 @@ enum fh_error fh_see_word(
size_t wordlen
);
/* if the return address is this, we should drop back to interactive mode */
// SFR and magic addresses are "negative"
#define MAGICADDR_EXEC_INTERACTIVE 0xFFFFFFFFULL
#define MAGICADDR_BASE 0xFFFFBA5EULL
#define MAGICADDR_HERE 0xFFFF4E7EULL
#define MAGICADDR_INPTR 0xFFFFF111ULL
#define MAGICADDR_UNRESOLVED 0xFFFFFBADULL
/** Get a value rounded up to multiple of word size */
#define WORDALIGNED(var) (((var) + 3) & ~3)
_Static_assert(WORDALIGNED(0) == 0, "word align");
_Static_assert(WORDALIGNED(1) == 4, "word align");
_Static_assert(WORDALIGNED(2) == 4, "word align");
_Static_assert(WORDALIGNED(3) == 4, "word align");
_Static_assert(WORDALIGNED(4) == 4, "word align");
_Static_assert(WORDALIGNED(5) == 8, "word align");
_Static_assert(WORDALIGNED(1023) == 1024, "word align");
_Static_assert(WORDALIGNED(1024) == 1024, "word align");
#define TRY(x) \
do { \
if (FH_OK != (rv = (x))) return rv; \
} while (0)
/**
* Execute a dictionary word from a definition stored at the given address
* @param fh
@@ -278,4 +244,8 @@ 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);
enum fh_error fh_init(struct fh_thread_s *fh);
enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_t len);
#endif //FORTH_FH_RUNTIME_H
include/fh_stack.h
+3
View File
@@ -18,6 +18,9 @@ static inline enum fh_error cs_peek_n(struct fh_thread_s *fh, uint32_t *out, int
return ds_peek_n(fh, out, n);
}
enum fh_error ds_push_dw(struct fh_thread_s *fh, uint64_t in);
enum fh_error ds_pop_dw(struct fh_thread_s *fh, uint64_t *out);
enum fh_error rs_poke_n(struct fh_thread_s *fh, uint32_t value, int n);
/** Peek top of data stack */
include/forth.h
+3 -5
View File
@@ -13,10 +13,8 @@
#include "fh_config.h"
#include "fh_error.h"
struct fh_thread_s;
enum fh_error fh_init(struct fh_thread_s *fh);
enum fh_error fh_process_line(struct fh_thread_s *fh, const char *linebuf, size_t len);
#include "fh_globals.h"
#include "fh_runtime.h"
#include "fh_print.h"
#endif //FORTH_H
include/forth_internal.h
+31
View File
@@ -0,0 +1,31 @@
/**
* TODO file description
*
* Created on 2021/11/17.
*/
#ifndef FORTH_FORTH_INTERNAL_H
#define FORTH_FORTH_INTERNAL_H
#include <string.h>
#include <stdint.h>
#include <stdbool.h>
#include <ctype.h>
#include <errno.h>
#include <assert.h>
#include <stdio.h>
#include <stdlib.h>
#include <stddef.h>
#include "fh_config.h"
#include "fh_error.h"
#include "fh_helpers.h"
#include "fh_globals.h"
#include "fh_print.h"
#include "fh_runtime.h"
#include "fh_mem.h"
#include "fh_stack.h"
#include "fh_parse.h"
#include "fh_builtins.h"
#endif //FORTH_FORTH_INTERNAL_H
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++;
testfiles/combinedtest.f
+1845
View File
File diff suppressed because it is too large Load Diff
testfiles/ifmacro.f
+33
View File
@@ -0,0 +1,33 @@
1 [if] ." One,"
0
[if] bla bla
[if]
[if] this
[then]
is
[then]
not parsed
[else]
." Two,"
[then]
." Bla bla,"
[then]
." End,"
0
[if]
blabla
[else]
1
[if]
char A EMIT
[else]
[if]
[if] this
[then]
is not parsed
[then]
[then]
[then]
char X EMIT