misc/kforth: Mostly finished with nucleus layer.

This commit is contained in:
Kyle Isom 2018-03-01 16:09:06 -08:00
parent adafdaa128
commit d96bf65a24
12 changed files with 587 additions and 52 deletions

View File

@ -1,5 +1,5 @@
CXXSTD := c++14
CXXFLAGS := -std=$(CXXSTD) -Wall -Werror -O0 -g -static
CXXFLAGS := -std=$(CXXSTD) -Wall -Werror -O0 -g
LDFLAGS := -static
OBJS := linux/io.o \
io.o \
@ -13,7 +13,7 @@ TARGET := kforth
all: $(TARGET)
$(TARGET): $(OBJS)
$(CXX) $(CXXFLAGS) -o $@ $(OBJS)
$(CXX) $(LDFLAGS) -o $@ $(OBJS)
clean:
rm -f $(OBJS) $(TARGET)

View File

@ -1,20 +1,8 @@
nucleus layer:
+ !
+ +!
+ @
+ C!
+ C@
+ CMOVE
+ CMOVE>
+ COUNT
+ FILL
+ EXECUTE
+ EXIT
+ I
+ J
+ >R
+ R>
+ R@
+ U<
+ UM*
+ UM/MOD
+ EXIT: requires better execution control
+ I: requires support for loop index
+ J: requires support for loop index
return addressing / rstack
dictionary -> fixed size stack / array

466
dict.cc
View File

@ -7,8 +7,6 @@
#include <stdlib.h>
#include <string.h>
constexpr size_t dshift = (sizeof(KF_INT) * 8) - 1;
static bool
pop_long(System *sys, KF_LONG *d)
{
@ -30,18 +28,6 @@ pop_long(System *sys, KF_LONG *d)
return true;
}
static inline KF_INT
mask(size_t bits)
{
KF_INT m = 0;
for (size_t i = 0; i < bits; i++) {
m += 1 << i;
}
return m;
}
static bool
push_long(System *sys, KF_LONG d)
{
@ -62,6 +48,33 @@ push_long(System *sys, KF_LONG d)
return true;
}
static bool
pop_addr(System *sys, KF_ADDR *a)
{
KF_LONG b;
if (!pop_long(sys, &b)) {
// Status is already set.
return false;
}
*a = static_cast<KF_ADDR>(b);
sys->status = STATUS_OK;
return true;
}
static bool
push_addr(System *sys, KF_ADDR a)
{
KF_LONG b = static_cast<KF_LONG>(a);
if (!push_long(sys, b)) {
// Status is already set.
return false;
}
sys->status = STATUS_OK;
return true;
}
static bool
add(System *sys)
{
@ -468,27 +481,25 @@ divide_mod(System *sys)
return true;
}
/*
static bool
store(System *sys)
{
KF_INT a = 0; // address
KF_ADDR a = 0; // address
KF_INT b = 0; // value
KF_LONG c = 0; // temporary
if (!sys->dstack.pop(&a)) {
if (!pop_long(sys, &c)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
a = static_cast<KF_ADDR>(c);
if (!sys->dstack.pop(&b)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
KF_INT *p = (KF_INT *)(a);
*p = b;
*((KF_INT *)a) = b;
sys->status = STATUS_OK;
return true;
}
@ -496,26 +507,47 @@ store(System *sys)
static bool
plus_store(System *sys)
{
KF_INT a = 0; // address
KF_ADDR a = 0; // address
KF_INT b = 0; // value
KF_LONG c = 0; // temporary
if (!sys->dstack.pop(&a)) {
if (!pop_long(sys, &c)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
a = static_cast<KF_ADDR>(c);
if (!sys->dstack.pop(&b)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
KF_INT *p = (KF_INT *)(a);
*p += b;
*((KF_INT *)a) += b;
sys->status = STATUS_OK;
return true;
}
static bool
fetch(System *sys)
{
KF_ADDR a = 0; // address
KF_INT b = 0; // value
KF_LONG c = 0; // temporary
if (!pop_long(sys, &c)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
a = static_cast<KF_ADDR>(c);
b = *((KF_INT *)a);
if (!sys->dstack.push(b)) {
sys->status = STATUS_STACK_OVERFLOW;
return false;
}
sys->status = STATUS_OK;
return true;
}
*/
static bool
zero_less(System *sys)
@ -1173,14 +1205,379 @@ mod(System *sys)
return true;
}
static bool
to_r(System *sys)
{
KF_INT a;
if (!sys->dstack.pop(&a)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
if (!sys->rstack.push(static_cast<KF_ADDR>(a))) {
sys->status = STATUS_RSTACK_OVERFLOW;
return false;
}
sys->status = STATUS_OK;
return true;
}
static bool
from_r(System *sys)
{
KF_ADDR a;
if (!sys->rstack.pop(&a)) {
sys->status = STATUS_RSTACK_UNDERFLOW;
return false;
}
if (!sys->dstack.push(static_cast<KF_INT>(a))) {
sys->status = STATUS_STACK_OVERFLOW;
return false;
}
sys->status = STATUS_OK;
return true;
}
static bool
r_fetch(System *sys)
{
KF_ADDR a;
if (!sys->rstack.peek(&a)) {
sys->status = STATUS_RSTACK_UNDERFLOW;
return false;
}
if (!sys->dstack.push(static_cast<KF_INT>(a))) {
sys->status = STATUS_STACK_OVERFLOW;
return false;
}
sys->status = STATUS_OK;
return true;
}
static bool
c_fetch(System *sys)
{
KF_ADDR a;
uint8_t b; // the standard explicitly calls for a byte.
if (!pop_addr(sys, &a)) {
// Status is already set.
return false;
}
b = *(reinterpret_cast<uint8_t *>(a));
if (!sys->dstack.push(static_cast<KF_INT>(b))) {
sys->status = STATUS_STACK_OVERFLOW;
return false;
}
sys->status = STATUS_OK;
return true;
}
static bool
c_store(System *sys)
{
KF_ADDR a;
KF_INT b;
if (!pop_addr(sys, &a)) {
// Status is already set.
return false;
}
if (!sys->dstack.pop(&b)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
b &= 0xFF;
*(reinterpret_cast<uint8_t *>(a)) = b;
sys->status = STATUS_OK;
return true;
}
static bool
c_move(System *sys)
{
KF_UINT a;
KF_INT b;
KF_ADDR c, d;
if (!sys->dstack.pop(&b)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
a = static_cast<KF_UINT>(b);
if (!pop_addr(sys, &d)) {
// Status is already set.
return false;
}
if (!pop_addr(sys, &c)) {
// Status is already set.
return false;
}
for (KF_UINT i = 0; i < a; i++) {
*reinterpret_cast<uint8_t *>(d + i) =
*reinterpret_cast<uint8_t *>(c + i);
}
sys->status = STATUS_OK;
return true;
}
static bool
c_move_up(System *sys)
{
KF_UINT a;
KF_INT b;
KF_ADDR c, d;
if (!sys->dstack.pop(&b)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
a = static_cast<KF_UINT>(b);
if (!pop_addr(sys, &d)) {
// Status is already set.
return false;
}
if (!pop_addr(sys, &c)) {
// Status is already set.
return false;
}
for (KF_UINT i = 0; i < a; i++) {
*reinterpret_cast<uint8_t *>(d - i) =
*reinterpret_cast<uint8_t *>(c - i);
}
sys->status = STATUS_OK;
return true;
}
static bool
fill(System *sys)
{
KF_INT a, c;
uint8_t b;
KF_UINT d;
KF_ADDR e;
if (!sys->dstack.pop(&a)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
b = static_cast<uint8_t>(a);
if (!sys->dstack.pop(&c)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
d = static_cast<KF_UINT>(c);
if (!pop_addr(sys, &e)) {
// Status is already set.
return false;
}
for (KF_UINT i = 0; i < d; i++) {
*reinterpret_cast<uint8_t *>(e + i) = b;
}
sys->status = STATUS_OK;
return true;
}
static bool
count(System *sys)
{
uint8_t a;
KF_ADDR b;
if (!pop_addr(sys, &b)) {
// Status is already set.
return false;
}
a = *reinterpret_cast<uint8_t *>(b);
b++;
if (!push_addr(sys, b)) {
// Status is already set.
return false;
}
if (!sys->dstack.push(static_cast<KF_INT>(a))) {
sys->status = STATUS_STACK_OVERFLOW;
return false;
}
sys->status = STATUS_OK;
return true;
}
static bool
execute(System *sys)
{
KF_ADDR a;
Word *b;
if (!pop_addr(sys, &a)) {
// Status is already set.
return false;
}
b = reinterpret_cast<Word *>(a);
char buf[MAX_TOKEN_LENGTH];
size_t buflen;
b->getname(buf, &buflen);
sys->interface->wrbuf((char *)"executing word: ", 16);
sys->interface->wrbuf(buf, buflen);
sys->interface->newline();
return b->eval(sys);
}
static bool
u_dot(System *sys)
{
KF_INT a;
KF_UINT b;
if (!sys->dstack.pop(&a)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
b = static_cast<KF_UINT>(a);
write_unum(sys->interface, b);
sys->interface->newline();
sys->status = STATUS_OK;
return true;
}
static bool
ult(System *sys)
{
KF_INT a, b;
bool ok;
if (!sys->dstack.pop(&a)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
if (!sys->dstack.pop(&b)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
if (static_cast<KF_UINT>(b) < static_cast<KF_UINT>(a)) {
ok = sys->dstack.push(-1);
}
else {
ok = sys->dstack.push(0);
}
if (!ok) {
sys->status = STATUS_STACK_OVERFLOW;
return false;
}
sys->status = STATUS_OK;
return true;
}
static bool
u_times(System *sys)
{
KF_INT a, b;
if (!sys->dstack.pop(&a)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
if (!sys->dstack.pop(&b)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
a = static_cast<KF_UINT>(a) * static_cast<KF_UINT>(b);
if (!sys->dstack.push(a)) {
sys->status = STATUS_STACK_OVERFLOW;
return false;
}
sys->status = STATUS_OK;
return true;
}
static bool
udivide_mod(System *sys)
{
KF_INT a, b;
KF_INT y, z;
if (!sys->dstack.pop(&a)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
if (!sys->dstack.pop(&b)) {
sys->status = STATUS_STACK_UNDERFLOW;
return false;
}
z = (KF_UINT)b / (KF_UINT)a;
y = (KF_UINT)b % (KF_UINT)a;
if (!sys->dstack.push(y)) {
sys->status = STATUS_STACK_OVERFLOW;
return false;
}
if (!sys->dstack.push(z)) {
sys->status = STATUS_STACK_OVERFLOW;
return false;
}
sys->status = STATUS_OK;
return true;
}
void
init_dict(System *sys)
{
sys->dict = nullptr;
sys->dict = new Builtin((const char *)"U/MOD", 5, sys->dict, udivide_mod);
sys->dict = new Builtin((const char *)"UM*", 3, sys->dict, u_times);
sys->dict = new Builtin((const char *)"U<", 2, sys->dict, ult);
sys->dict = new Builtin((const char *)"U.", 2, sys->dict, u_dot);
sys->dict = new Builtin((const char *)"SWAP", 4, sys->dict, swap);
sys->dict = new Builtin((const char *)"SWAP", 4, sys->dict, swap);
sys->dict = new Builtin((const char *)"XOR", 3, sys->dict, exclusive_or);
sys->dict = new Builtin((const char *)"ROT", 3, sys->dict, rot);
sys->dict = new Builtin((const char *)"ROLL", 4, sys->dict, roll);
sys->dict = new Builtin((const char *)"R@", 2, sys->dict, r_fetch);
sys->dict = new Builtin((const char *)"R>", 2, sys->dict, from_r);
sys->dict = new Builtin((const char *)"PICK", 4, sys->dict, pick);
sys->dict = new Builtin((const char *)"OVER", 4, sys->dict, over);
sys->dict = new Builtin((const char *)"NEGATE", 6, sys->dict, negate);
@ -1188,6 +1585,8 @@ init_dict(System *sys)
sys->dict = new Builtin((const char *)"MOD", 3, sys->dict, mod);
sys->dict = new Builtin((const char *)"MIN", 3, sys->dict, min);
sys->dict = new Builtin((const char *)"MAX", 3, sys->dict, max);
sys->dict = new Builtin((const char *)"FILL", 4, sys->dict, fill);
sys->dict = new Builtin((const char *)"EXECUTE", 7, sys->dict, execute);
sys->dict = new Builtin((const char *)"DUP", 3, sys->dict, dup);
sys->dict = new Builtin((const char *)"DROP", 4, sys->dict, drop);
sys->dict = new Builtin((const char *)"DEPTH", 5, sys->dict, depth);
@ -1196,10 +1595,17 @@ init_dict(System *sys)
sys->dict = new Builtin((const char *)"D.", 2, sys->dict, ddot);
sys->dict = new Builtin((const char *)"D<", 2, sys->dict, dlt);
sys->dict = new Builtin((const char *)"D+", 2, sys->dict, dplus);
sys->dict = new Builtin((const char *)"COUNT", 5, sys->dict, count);
sys->dict = new Builtin((const char *)"CMOVE>", 6, sys->dict, c_move_up);
sys->dict = new Builtin((const char *)"CMOVE", 5, sys->dict, c_move);
sys->dict = new Builtin((const char *)"C@", 2, sys->dict, c_fetch);
sys->dict = new Builtin((const char *)"C!", 2, sys->dict, c_store);
sys->dict = new Builtin((const char *)"BYE", 3, sys->dict, bye);
sys->dict = new Builtin((const char *)"ABS", 3, sys->dict, absolute);
sys->dict = new Builtin((const char *)"AND", 3, sys->dict, land);
sys->dict = new Builtin((const char *)"@", 1, sys->dict, fetch);
sys->dict = new Builtin((const char *)"?DUP", 4, sys->dict, question_dupe);
sys->dict = new Builtin((const char *)">R", 2, sys->dict, to_r);
sys->dict = new Builtin((const char *)">", 1, sys->dict, greater_than);
sys->dict = new Builtin((const char *)"=", 1, sys->dict, equals);
sys->dict = new Builtin((const char *)"<", 1, sys->dict, less_than);
@ -1218,10 +1624,12 @@ init_dict(System *sys)
sys->dict = new Builtin((const char *)".S", 2, sys->dict, dotess);
sys->dict = new Builtin((const char *)".", 1, sys->dict, dot);
sys->dict = new Builtin((const char *)"-", 1, sys->dict, sub);
// sys->dict = new Builtin((const char *)"+!", 2, sys->dict, plus_store);
sys->dict = new Builtin((const char *)"+!", 2, sys->dict, plus_store);
sys->dict = new Builtin((const char *)"+", 1, sys->dict, add);
sys->dict = new Builtin((const char *)"*", 1, sys->dict, mul);
// sys->dict = new Builtin((const char *)"!", 1, sys->dict, store);
sys->dict = new Builtin((const char *)"!", 1, sys->dict, store);
sys->dict = new Address((const char *)"ARENA", 5, sys->dict, reinterpret_cast<KF_ADDR>(&sys->arena));
sys->dict = new Address((const char *)"DICT", 5, sys->dict, reinterpret_cast<KF_ADDR>(&sys->dict));
}
bool

View File

@ -9,6 +9,12 @@ X-type series where I'll write up my thinking and planning as I go.
.. _last post: https://dl.kyleisom.net/posts/2018/02/21/2018-02-21-revisiting-forth/
I've always wanted to write a Forth_; I've made a few attempts_ at it in the
past. This time, I'm actually going to do it.
.. _Forth: https://en.wikipedia.org/wiki/Forth_(programming_language)
.. _attempts: https://github.com/isrlabs/avr-forth
The basics
^^^^^^^^^^

23
io.cc
View File

@ -30,6 +30,29 @@ write_num(IO *interface, KF_INT n)
interface->wrbuf(buf+i, nbuflen - i);
}
void
write_unum(IO *interface, KF_UINT n)
{
static constexpr size_t nbuflen = 11;
char buf[nbuflen];
uint8_t i = nbuflen - 1;
memset(buf, 0, nbuflen);
if (n == 0) {
interface->wrch('0');
return;
}
while (n != 0) {
char x = n % 10;
x += '0';
buf[i--] = x;
n /= 10;
}
interface->wrbuf(buf+i, nbuflen - i);
}
void
write_dnum(IO *interface, KF_LONG n)
{

1
io.h
View File

@ -25,6 +25,7 @@ public:
};
void write_num(IO *, KF_INT);
void write_unum(IO *, KF_UINT);
void write_dnum(IO *, KF_LONG);
void write_dstack(IO *, Stack<KF_INT>);

View File

@ -5,8 +5,24 @@
#include <stdint.h>
typedef int32_t KF_INT;
typedef uint32_t KF_UINT;
typedef int64_t KF_LONG;
constexpr size_t dshift = (sizeof(KF_INT) * 8) - 1;
typedef uintptr_t KF_ADDR;
constexpr uint8_t STACK_SIZE = 128;
constexpr size_t ARENA_SIZE = 65535;
static inline KF_INT
mask(size_t bits)
{
KF_INT m = 0;
for (size_t i = 0; i < bits; i++) {
m += 1 << i;
}
return m;
}
#endif

15
stack.h
View File

@ -8,6 +8,7 @@ class Stack {
public:
bool push(T val);
bool pop(T *val);
bool peek(T *val);
bool get(size_t, T &);
bool remove(size_t, T *);
size_t size(void) { return this->arrlen; }
@ -44,6 +45,20 @@ Stack<T>::pop(T *val)
return true;
}
// peek returns false if there was a stack underflow.
template <typename T>
bool
Stack<T>::peek(T *val)
{
if (this->arrlen == 0) {
return false;
}
*val = this->arr[this->arrlen - 1];
return true;
}
// get returns false on invalid bounds.
template <typename T>
bool

View File

@ -8,6 +8,8 @@ constexpr static char STATE_STR_STACK_OVERFLOW[] = "stack overflow";
constexpr static char STATE_STR_STACK_UNDERFLOW[] = "stack underflow";
constexpr static char STATE_STR_EXECUTION_FAILURE[] = "execution failure";
constexpr static char STATE_STR_UNKNOWN_WORD[] = "unknown word";
constexpr static char STATE_STR_RSTACK_OVERFLOW[] = "return stack overflow";
constexpr static char STATE_STR_RSTACK_UNDERFLOW[] = "return stack underflow";
constexpr static char STATE_STR_UNKNOWN_STATE[] = "undefined state";
constexpr static char STATE_STR_ERROR_CODE[] = " (error code ";
@ -48,6 +50,14 @@ system_write_status(System *sys)
buf = (char *)(STATE_STR_UNKNOWN_WORD);
len = sizeof STATE_STR_UNKNOWN_WORD;
break;
case STATUS_RSTACK_OVERFLOW:
buf = (char *)(STATE_STR_RSTACK_OVERFLOW);
len = sizeof STATE_STR_RSTACK_OVERFLOW;
break;
case STATUS_RSTACK_UNDERFLOW:
buf = (char *)(STATE_STR_RSTACK_UNDERFLOW);
len = sizeof STATE_STR_RSTACK_UNDERFLOW;
break;
default:
buf = (char *)(STATE_STR_UNKNOWN_STATE);
len = sizeof STATE_STR_UNKNOWN_STATE;

View File

@ -10,16 +10,20 @@ typedef enum _SYS_STATUS : uint8_t {
STATUS_STACK_OVERFLOW = 1,
STATUS_STACK_UNDERFLOW = 2,
STATUS_EXECUTION_FAILURE = 3,
STATUS_UNKNOWN_WORD = 4
STATUS_UNKNOWN_WORD = 4,
STATUS_RSTACK_OVERFLOW = 5,
STATUS_RSTACK_UNDERFLOW = 6
} SYS_STATUS;
class Word;
typedef struct _System {
Stack<KF_INT> dstack;
Stack<KF_ADDR> rstack;
IO *interface;
Word *dict;
SYS_STATUS status;
uint8_t arena[ARENA_SIZE];
} System;
void system_clear_error(System *sys);

45
word.cc
View File

@ -37,3 +37,48 @@ Builtin::getname(char *buf, size_t *buflen)
memcpy(buf, this->name, this->namelen);
*buflen = namelen;
}
Address::Address(const char *name, size_t namelen, Word *head, KF_ADDR addr)
: prev(head), addr(addr)
{
memcpy(this->name, name, namelen);
this->namelen = namelen;
}
bool
Address::eval(System *sys)
{
KF_INT a;
a = static_cast<KF_INT>(this->addr & mask(dshift));
if (!sys->dstack.push(a)) {
return false;
}
a = static_cast<KF_INT>((this->addr >> dshift) & mask(dshift));
if (!sys->dstack.push(a)) {
return false;
}
return true;
}
Word *
Address::next(void)
{
return this->prev;
}
bool
Address::match(struct Token *token)
{
return match_token(this->name, this->namelen, token->token, token->length);
}
void
Address::getname(char *buf, size_t *buflen)
{
memcpy(buf, this->name, this->namelen);
*buflen = namelen;
}

19
word.h
View File

@ -14,6 +14,7 @@ public:
virtual Word *next(void) = 0;
virtual bool match(struct Token *) = 0;
virtual void getname(char *, size_t *) = 0;
virtual uintptr_t address(void) = 0;
};
class Builtin : public Word {
@ -25,6 +26,7 @@ public:
Word *next(void);
bool match(struct Token *);
void getname(char *, size_t *);
uintptr_t address(void) { return reinterpret_cast<uintptr_t>(this); }
private:
char name[MAX_TOKEN_LENGTH];
size_t namelen;
@ -32,4 +34,21 @@ private:
bool (*fun)(System *);
};
class Address : public Word {
public:
~Address() {};
Address(const char *name, size_t namelen, Word *head, KF_ADDR addr);
bool eval(System *);
Word *next(void);
bool match(struct Token *);
void getname(char *, size_t *);
uintptr_t address(void) { return reinterpret_cast<uintptr_t>(this); }
private:
char name[MAX_TOKEN_LENGTH];
size_t namelen;
Word *prev;
KF_ADDR addr;
};
#endif // __KF_WORD_H__