misc/kforth: Mostly finished with nucleus layer.
This commit is contained in:
parent
adafdaa128
commit
d96bf65a24
4
Makefile
4
Makefile
|
@ -1,5 +1,5 @@
|
||||||
CXXSTD := c++14
|
CXXSTD := c++14
|
||||||
CXXFLAGS := -std=$(CXXSTD) -Wall -Werror -O0 -g -static
|
CXXFLAGS := -std=$(CXXSTD) -Wall -Werror -O0 -g
|
||||||
LDFLAGS := -static
|
LDFLAGS := -static
|
||||||
OBJS := linux/io.o \
|
OBJS := linux/io.o \
|
||||||
io.o \
|
io.o \
|
||||||
|
@ -13,7 +13,7 @@ TARGET := kforth
|
||||||
all: $(TARGET)
|
all: $(TARGET)
|
||||||
|
|
||||||
$(TARGET): $(OBJS)
|
$(TARGET): $(OBJS)
|
||||||
$(CXX) $(CXXFLAGS) -o $@ $(OBJS)
|
$(CXX) $(LDFLAGS) -o $@ $(OBJS)
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -f $(OBJS) $(TARGET)
|
rm -f $(OBJS) $(TARGET)
|
||||||
|
|
26
TODO.txt
26
TODO.txt
|
@ -1,20 +1,8 @@
|
||||||
nucleus layer:
|
nucleus layer:
|
||||||
+ !
|
+ EXIT: requires better execution control
|
||||||
+ +!
|
+ I: requires support for loop index
|
||||||
+ @
|
+ J: requires support for loop index
|
||||||
+ C!
|
|
||||||
+ C@
|
return addressing / rstack
|
||||||
+ CMOVE
|
dictionary -> fixed size stack / array
|
||||||
+ CMOVE>
|
|
||||||
+ COUNT
|
|
||||||
+ FILL
|
|
||||||
+ EXECUTE
|
|
||||||
+ EXIT
|
|
||||||
+ I
|
|
||||||
+ J
|
|
||||||
+ >R
|
|
||||||
+ R>
|
|
||||||
+ R@
|
|
||||||
+ U<
|
|
||||||
+ UM*
|
|
||||||
+ UM/MOD
|
|
||||||
|
|
466
dict.cc
466
dict.cc
|
@ -7,8 +7,6 @@
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
constexpr size_t dshift = (sizeof(KF_INT) * 8) - 1;
|
|
||||||
|
|
||||||
static bool
|
static bool
|
||||||
pop_long(System *sys, KF_LONG *d)
|
pop_long(System *sys, KF_LONG *d)
|
||||||
{
|
{
|
||||||
|
@ -30,18 +28,6 @@ pop_long(System *sys, KF_LONG *d)
|
||||||
return true;
|
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
|
static bool
|
||||||
push_long(System *sys, KF_LONG d)
|
push_long(System *sys, KF_LONG d)
|
||||||
{
|
{
|
||||||
|
@ -62,6 +48,33 @@ push_long(System *sys, KF_LONG d)
|
||||||
return true;
|
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
|
static bool
|
||||||
add(System *sys)
|
add(System *sys)
|
||||||
{
|
{
|
||||||
|
@ -468,27 +481,25 @@ divide_mod(System *sys)
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/*
|
|
||||||
static bool
|
static bool
|
||||||
store(System *sys)
|
store(System *sys)
|
||||||
{
|
{
|
||||||
KF_INT a = 0; // address
|
KF_ADDR a = 0; // address
|
||||||
KF_INT b = 0; // value
|
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;
|
sys->status = STATUS_STACK_UNDERFLOW;
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
a = static_cast<KF_ADDR>(c);
|
||||||
|
|
||||||
if (!sys->dstack.pop(&b)) {
|
if (!sys->dstack.pop(&b)) {
|
||||||
sys->status = STATUS_STACK_UNDERFLOW;
|
sys->status = STATUS_STACK_UNDERFLOW;
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
KF_INT *p = (KF_INT *)(a);
|
*((KF_INT *)a) = b;
|
||||||
*p = b;
|
|
||||||
|
|
||||||
sys->status = STATUS_OK;
|
sys->status = STATUS_OK;
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
@ -496,26 +507,47 @@ store(System *sys)
|
||||||
static bool
|
static bool
|
||||||
plus_store(System *sys)
|
plus_store(System *sys)
|
||||||
{
|
{
|
||||||
KF_INT a = 0; // address
|
KF_ADDR a = 0; // address
|
||||||
KF_INT b = 0; // value
|
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;
|
sys->status = STATUS_STACK_UNDERFLOW;
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
a = static_cast<KF_ADDR>(c);
|
||||||
|
|
||||||
if (!sys->dstack.pop(&b)) {
|
if (!sys->dstack.pop(&b)) {
|
||||||
sys->status = STATUS_STACK_UNDERFLOW;
|
sys->status = STATUS_STACK_UNDERFLOW;
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
KF_INT *p = (KF_INT *)(a);
|
*((KF_INT *)a) += b;
|
||||||
*p += 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;
|
sys->status = STATUS_OK;
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
*/
|
|
||||||
|
|
||||||
static bool
|
static bool
|
||||||
zero_less(System *sys)
|
zero_less(System *sys)
|
||||||
|
@ -1173,14 +1205,379 @@ mod(System *sys)
|
||||||
return true;
|
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
|
void
|
||||||
init_dict(System *sys)
|
init_dict(System *sys)
|
||||||
{
|
{
|
||||||
sys->dict = nullptr;
|
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 *)"SWAP", 4, sys->dict, swap);
|
||||||
sys->dict = new Builtin((const char *)"XOR", 3, sys->dict, exclusive_or);
|
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 *)"ROT", 3, sys->dict, rot);
|
||||||
sys->dict = new Builtin((const char *)"ROLL", 4, sys->dict, roll);
|
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 *)"PICK", 4, sys->dict, pick);
|
||||||
sys->dict = new Builtin((const char *)"OVER", 4, sys->dict, over);
|
sys->dict = new Builtin((const char *)"OVER", 4, sys->dict, over);
|
||||||
sys->dict = new Builtin((const char *)"NEGATE", 6, sys->dict, negate);
|
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 *)"MOD", 3, sys->dict, mod);
|
||||||
sys->dict = new Builtin((const char *)"MIN", 3, sys->dict, min);
|
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 *)"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 *)"DUP", 3, sys->dict, dup);
|
||||||
sys->dict = new Builtin((const char *)"DROP", 4, sys->dict, drop);
|
sys->dict = new Builtin((const char *)"DROP", 4, sys->dict, drop);
|
||||||
sys->dict = new Builtin((const char *)"DEPTH", 5, sys->dict, depth);
|
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, ddot);
|
||||||
sys->dict = new Builtin((const char *)"D<", 2, sys->dict, dlt);
|
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 *)"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 *)"BYE", 3, sys->dict, bye);
|
||||||
sys->dict = new Builtin((const char *)"ABS", 3, sys->dict, absolute);
|
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 *)"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 *)"?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, greater_than);
|
||||||
sys->dict = new Builtin((const char *)"=", 1, sys->dict, equals);
|
sys->dict = new Builtin((const char *)"=", 1, sys->dict, equals);
|
||||||
sys->dict = new Builtin((const char *)"<", 1, sys->dict, less_than);
|
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 *)".S", 2, sys->dict, dotess);
|
||||||
sys->dict = new Builtin((const char *)".", 1, sys->dict, dot);
|
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 *)"-", 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, add);
|
||||||
sys->dict = new Builtin((const char *)"*", 1, sys->dict, mul);
|
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
|
bool
|
||||||
|
|
|
@ -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/
|
.. _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
|
The basics
|
||||||
^^^^^^^^^^
|
^^^^^^^^^^
|
||||||
|
|
||||||
|
|
23
io.cc
23
io.cc
|
@ -30,6 +30,29 @@ write_num(IO *interface, KF_INT n)
|
||||||
interface->wrbuf(buf+i, nbuflen - i);
|
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
|
void
|
||||||
write_dnum(IO *interface, KF_LONG n)
|
write_dnum(IO *interface, KF_LONG n)
|
||||||
{
|
{
|
||||||
|
|
1
io.h
1
io.h
|
@ -25,6 +25,7 @@ public:
|
||||||
};
|
};
|
||||||
|
|
||||||
void write_num(IO *, KF_INT);
|
void write_num(IO *, KF_INT);
|
||||||
|
void write_unum(IO *, KF_UINT);
|
||||||
void write_dnum(IO *, KF_LONG);
|
void write_dnum(IO *, KF_LONG);
|
||||||
void write_dstack(IO *, Stack<KF_INT>);
|
void write_dstack(IO *, Stack<KF_INT>);
|
||||||
|
|
||||||
|
|
16
linux/defs.h
16
linux/defs.h
|
@ -5,8 +5,24 @@
|
||||||
#include <stdint.h>
|
#include <stdint.h>
|
||||||
|
|
||||||
typedef int32_t KF_INT;
|
typedef int32_t KF_INT;
|
||||||
|
typedef uint32_t KF_UINT;
|
||||||
typedef int64_t KF_LONG;
|
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 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
|
#endif
|
15
stack.h
15
stack.h
|
@ -8,6 +8,7 @@ class Stack {
|
||||||
public:
|
public:
|
||||||
bool push(T val);
|
bool push(T val);
|
||||||
bool pop(T *val);
|
bool pop(T *val);
|
||||||
|
bool peek(T *val);
|
||||||
bool get(size_t, T &);
|
bool get(size_t, T &);
|
||||||
bool remove(size_t, T *);
|
bool remove(size_t, T *);
|
||||||
size_t size(void) { return this->arrlen; }
|
size_t size(void) { return this->arrlen; }
|
||||||
|
@ -44,6 +45,20 @@ Stack<T>::pop(T *val)
|
||||||
return true;
|
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.
|
// get returns false on invalid bounds.
|
||||||
template <typename T>
|
template <typename T>
|
||||||
bool
|
bool
|
||||||
|
|
10
system.cc
10
system.cc
|
@ -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_STACK_UNDERFLOW[] = "stack underflow";
|
||||||
constexpr static char STATE_STR_EXECUTION_FAILURE[] = "execution failure";
|
constexpr static char STATE_STR_EXECUTION_FAILURE[] = "execution failure";
|
||||||
constexpr static char STATE_STR_UNKNOWN_WORD[] = "unknown word";
|
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_UNKNOWN_STATE[] = "undefined state";
|
||||||
constexpr static char STATE_STR_ERROR_CODE[] = " (error code ";
|
constexpr static char STATE_STR_ERROR_CODE[] = " (error code ";
|
||||||
|
|
||||||
|
@ -48,6 +50,14 @@ system_write_status(System *sys)
|
||||||
buf = (char *)(STATE_STR_UNKNOWN_WORD);
|
buf = (char *)(STATE_STR_UNKNOWN_WORD);
|
||||||
len = sizeof STATE_STR_UNKNOWN_WORD;
|
len = sizeof STATE_STR_UNKNOWN_WORD;
|
||||||
break;
|
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:
|
default:
|
||||||
buf = (char *)(STATE_STR_UNKNOWN_STATE);
|
buf = (char *)(STATE_STR_UNKNOWN_STATE);
|
||||||
len = sizeof STATE_STR_UNKNOWN_STATE;
|
len = sizeof STATE_STR_UNKNOWN_STATE;
|
||||||
|
|
6
system.h
6
system.h
|
@ -10,16 +10,20 @@ typedef enum _SYS_STATUS : uint8_t {
|
||||||
STATUS_STACK_OVERFLOW = 1,
|
STATUS_STACK_OVERFLOW = 1,
|
||||||
STATUS_STACK_UNDERFLOW = 2,
|
STATUS_STACK_UNDERFLOW = 2,
|
||||||
STATUS_EXECUTION_FAILURE = 3,
|
STATUS_EXECUTION_FAILURE = 3,
|
||||||
STATUS_UNKNOWN_WORD = 4
|
STATUS_UNKNOWN_WORD = 4,
|
||||||
|
STATUS_RSTACK_OVERFLOW = 5,
|
||||||
|
STATUS_RSTACK_UNDERFLOW = 6
|
||||||
} SYS_STATUS;
|
} SYS_STATUS;
|
||||||
|
|
||||||
class Word;
|
class Word;
|
||||||
|
|
||||||
typedef struct _System {
|
typedef struct _System {
|
||||||
Stack<KF_INT> dstack;
|
Stack<KF_INT> dstack;
|
||||||
|
Stack<KF_ADDR> rstack;
|
||||||
IO *interface;
|
IO *interface;
|
||||||
Word *dict;
|
Word *dict;
|
||||||
SYS_STATUS status;
|
SYS_STATUS status;
|
||||||
|
uint8_t arena[ARENA_SIZE];
|
||||||
} System;
|
} System;
|
||||||
|
|
||||||
void system_clear_error(System *sys);
|
void system_clear_error(System *sys);
|
||||||
|
|
45
word.cc
45
word.cc
|
@ -37,3 +37,48 @@ Builtin::getname(char *buf, size_t *buflen)
|
||||||
memcpy(buf, this->name, this->namelen);
|
memcpy(buf, this->name, this->namelen);
|
||||||
*buflen = 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
19
word.h
|
@ -14,6 +14,7 @@ public:
|
||||||
virtual Word *next(void) = 0;
|
virtual Word *next(void) = 0;
|
||||||
virtual bool match(struct Token *) = 0;
|
virtual bool match(struct Token *) = 0;
|
||||||
virtual void getname(char *, size_t *) = 0;
|
virtual void getname(char *, size_t *) = 0;
|
||||||
|
virtual uintptr_t address(void) = 0;
|
||||||
};
|
};
|
||||||
|
|
||||||
class Builtin : public Word {
|
class Builtin : public Word {
|
||||||
|
@ -25,6 +26,7 @@ public:
|
||||||
Word *next(void);
|
Word *next(void);
|
||||||
bool match(struct Token *);
|
bool match(struct Token *);
|
||||||
void getname(char *, size_t *);
|
void getname(char *, size_t *);
|
||||||
|
uintptr_t address(void) { return reinterpret_cast<uintptr_t>(this); }
|
||||||
private:
|
private:
|
||||||
char name[MAX_TOKEN_LENGTH];
|
char name[MAX_TOKEN_LENGTH];
|
||||||
size_t namelen;
|
size_t namelen;
|
||||||
|
@ -32,4 +34,21 @@ private:
|
||||||
bool (*fun)(System *);
|
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__
|
#endif // __KF_WORD_H__
|
Loading…
Reference in New Issue