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
 | 
			
		||||
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)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										26
									
								
								TODO.txt
								
								
								
								
							
							
						
						
									
										26
									
								
								TODO.txt
								
								
								
								
							| 
						 | 
				
			
			@ -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
								
								
								
								
							
							
						
						
									
										466
									
								
								dict.cc
								
								
								
								
							| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
								
								
								
								
							
							
						
						
									
										23
									
								
								io.cc
								
								
								
								
							| 
						 | 
				
			
			@ -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
								
								
								
								
							
							
						
						
									
										1
									
								
								io.h
								
								
								
								
							| 
						 | 
				
			
			@ -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>);
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										18
									
								
								linux/defs.h
								
								
								
								
							
							
						
						
									
										18
									
								
								linux/defs.h
								
								
								
								
							| 
						 | 
				
			
			@ -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;
 | 
			
		||||
 | 
			
		||||
constexpr uint8_t	STACK_SIZE = 128;
 | 
			
		||||
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
								
								
								
								
							
							
						
						
									
										15
									
								
								stack.h
								
								
								
								
							| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										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_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;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										6
									
								
								system.h
								
								
								
								
							
							
						
						
									
										6
									
								
								system.h
								
								
								
								
							| 
						 | 
				
			
			@ -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
								
								
								
								
							
							
						
						
									
										45
									
								
								word.cc
								
								
								
								
							| 
						 | 
				
			
			@ -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
								
								
								
								
							
							
						
						
									
										19
									
								
								word.h
								
								
								
								
							| 
						 | 
				
			
			@ -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__
 | 
			
		||||
		Loading…
	
		Reference in New Issue