*

1 files changed, 1214 insertions, 0 deletions

diff --git a/p9c/lbforth/lbforth9.c b/p9c/lbforth/lbforth9.c
new file mode 100644
index 0000000..6ee5fa6
--- /dev/null
+++ b/p9c/lbforth/lbforth9.c
@@ -0,0 +1,1214 @@
+/*******************************************************************************
+* A minimal Forth compiler in C
+* By Leif Bruder <leifbruder@gmail.com>
+* Release 2014-04-04
+* Modified by Devine Lu Linvega for Plan9 ARM
+* Patch 2020-10-06
+*
+* Based on Richard W.M. Jones' excellent Jonesforth sources/tutorial
+*
+* PUBLIC DOMAIN
+*
+* I, the copyright holder of this work, hereby release it into the public
+* domain. This applies worldwide. In case this is not legally possible, I grant
+* any entity the right to use this work for any purpose, without any conditions,
+* unless such conditions are required by law.
+*******************************************************************************/
+
+/* Only a single include here; I'll define everything on the fly to keep
+* dependencies as low as possible. In this file, the only C standard functions
+* used are getchar, putchar and the EOF value. */
+#include <stdio.h>
+
+/* Base cell data types. Use short/long on most systems for 16 bit cells. */
+/* Experiment here if necessary. */
+#define CELL_BASE_TYPE short
+#define DOUBLE_CELL_BASE_TYPE long
+
+/* Basic memory configuration */
+#define MEM_SIZE 65536 /* main memory size in bytes */
+#define STACK_SIZE 192 /* cells reserved for the stack */
+#define RSTACK_SIZE 64 /* cells reserved for the return stack */
+#define INPUT_LINE_SIZE 32 /* bytes reserved for the WORD buffer */
+
+/******************************************************************************/
+
+/* Our basic data types */
+typedef CELL_BASE_TYPE scell;
+typedef DOUBLE_CELL_BASE_TYPE dscell;
+typedef unsigned CELL_BASE_TYPE cell;
+typedef unsigned DOUBLE_CELL_BASE_TYPE dcell;
+typedef unsigned char byte;
+#define CELL_SIZE sizeof(cell)
+#define DCELL_SIZE sizeof(dcell)
+
+/* A few constants that describe the memory layout of this implementation */
+#define LATEST_POSITION INPUT_LINE_SIZE
+#define HERE_POSITION (LATEST_POSITION + CELL_SIZE)
+#define BASE_POSITION (HERE_POSITION + CELL_SIZE)
+#define STATE_POSITION (BASE_POSITION + CELL_SIZE)
+#define STACK_POSITION (STATE_POSITION + CELL_SIZE)
+#define RSTACK_POSITION (STACK_POSITION + STACK_SIZE * CELL_SIZE)
+#define HERE_START (RSTACK_POSITION + RSTACK_SIZE * CELL_SIZE)
+#define MAX_BUILTIN_ID 71
+
+/* Flags and masks for the dictionary */
+#define FLAG_IMMEDIATE 0x80
+#define FLAG_HIDDEN 0x40
+#define MASK_NAMELENGTH 0x1F
+
+/* This is the main memory to be used by this Forth. There will be no malloc
+* in this file. */
+byte memory[MEM_SIZE];
+
+/* Pointers to Forth variables stored inside the main memory array */
+cell* latest;
+cell* here;
+cell* base;
+cell* state;
+cell* sp;
+cell* stack;
+cell* rsp;
+cell* rstack;
+
+/* A few helper variables for the compiler */
+int exitReq;
+int errorFlag;
+cell next;
+cell lastIp;
+cell quit_address;
+cell commandAddress;
+cell maxBuiltinAddress;
+
+/* The TIB, stored outside the main memory array for now */
+char lineBuffer[128];
+int charsInLineBuffer = 0;
+int positionInLineBuffer = 0;
+
+/* A basic setup for defining builtins. This Forth uses impossibly low
+* adresses as IDs for the builtins so we can define builtins as
+* standard C functions. Slower but easier to port. */
+#define BUILTIN(id, name, c_name, flags)   \
+	const int c_name##_id = id;        \
+	const char* c_name##_name = name;  \
+	const byte c_name##_flags = flags; \
+	void c_name(void)
+#define ADD_BUILTIN(c_name) addBuiltin(c_name##_id, c_name##_name, c_name##_flags, c_name)
+typedef void (*builtin)(void);
+builtin builtins[MAX_BUILTIN_ID] = {0};
+
+/* This is our initialization script containing all the words we define in
+* Forth for convenience. Focus is on simplicity, not speed. Partly copied from
+* Jonesforth (see top of file). */
+char* initscript_pos;
+const char* initScript =
+    ": DECIMAL 10 BASE ! ;\n"
+    ": HEX 16 BASE ! ;\n"
+    ": OCTAL 8 BASE ! ;\n"
+    ": 2DUP OVER OVER ;\n"
+    ": 2DROP DROP DROP ;\n"
+    ": NIP SWAP DROP ;\n"
+    ": 2NIP 2SWAP 2DROP ;\n"
+    ": TUCK SWAP OVER ;\n"
+    ": / /MOD NIP ;\n"
+    ": MOD /MOD DROP ;\n"
+    ": BL 32 ;\n"
+    ": CR 10 EMIT ;\n"
+    ": SPACE BL EMIT ;\n"
+    ": NEGATE 0 SWAP - ;\n"
+    ": DNEGATE 0. 2SWAP D- ;\n"
+    ": CELLS CELL * ;\n"
+    ": ALLOT HERE @ + HERE ! ;\n"
+    ": TRUE -1 ;\n"
+    ": FALSE 0 ;\n"
+    ": 0= 0 = ;\n"
+    ": 0< 0 < ;\n"
+    ": 0> 0 > ;\n"
+    ": <> = 0= ;\n"
+    ": <= > 0= ;\n"
+    ": >= < 0= ;\n"
+    ": 0<= 0 <= ;\n"
+    ": 0>= 0 >= ;\n"
+    ": 1+ 1 + ;\n"
+    ": 1- 1 - ;\n"
+    ": 2+ 2 + ;\n"
+    ": 2- 2 - ;\n"
+    ": 2/ 2 / ;\n"
+    ": 2* 2 * ;\n"
+    ": D2/ 2. D/ ;\n"
+    ": +! DUP @ ROT + SWAP ! ;\n"
+    ": [COMPILE] WORD FIND >CFA , ; IMMEDIATE\n"
+    ": [CHAR] key ' LIT , , ; IMMEDIATE\n"
+    ": RECURSE LATEST @ >CFA , ; IMMEDIATE\n"
+    ": DOCOL 0 ;\n"
+    ": CONSTANT CREATE DOCOL , ' LIT , , ' EXIT , ;\n"
+    ": 2CONSTANT SWAP CREATE DOCOL , ' LIT , , ' LIT , , ' EXIT , ;\n"
+    ": VARIABLE HERE @ CELL ALLOT CREATE DOCOL , ' LIT , , ' EXIT , ;\n" /* TODO: Allot AFTER the code, not before */
+    ": 2VARIABLE HERE @ 2 CELLS ALLOT CREATE DOCOL , ' LIT , , ' EXIT , ;\n" /* TODO: Allot AFTER the code, not before */
+    ": IF ' 0BRANCH , HERE @ 0 , ; IMMEDIATE\n"
+    ": THEN DUP HERE @ SWAP - SWAP ! ; IMMEDIATE\n"
+    ": ELSE ' BRANCH , HERE @ 0 , SWAP DUP HERE @ SWAP - SWAP ! ; IMMEDIATE\n"
+    ": BEGIN HERE @ ; IMMEDIATE\n"
+    ": UNTIL ' 0BRANCH , HERE @ - , ; IMMEDIATE\n"
+    ": AGAIN ' BRANCH , HERE @ - , ; IMMEDIATE\n"
+    ": WHILE ' 0BRANCH , HERE @ 0 , ; IMMEDIATE\n"
+    ": REPEAT ' BRANCH , SWAP HERE @ - , DUP HERE @ SWAP - SWAP ! ; IMMEDIATE\n"
+    ": UNLESS ' 0= , [COMPILE] IF ; IMMEDIATE\n"
+    ": DO HERE @ ' SWAP , ' >R , ' >R , ; IMMEDIATE\n"
+    ": LOOP ' R> , ' R> , ' SWAP , ' 1+ , ' 2DUP , ' = , ' 0BRANCH , HERE @ - , ' 2DROP , ; IMMEDIATE\n"
+    ": +LOOP ' R> , ' R> , ' SWAP , ' ROT , ' + , ' 2DUP , ' <= , ' 0BRANCH , HERE @ - , ' 2DROP , ; IMMEDIATE\n"
+    ": I ' R@ , ; IMMEDIATE\n"
+    ": SPACES DUP 0> IF 0 DO SPACE LOOP ELSE DROP THEN ;\n"
+    ": ABS DUP 0< IF NEGATE THEN ;\n"
+    ": DABS 2DUP 0. D< IF DNEGATE THEN ;\n"
+    ": .DIGIT DUP 9 > IF 55 ELSE 48 THEN + EMIT ;\n"
+    ": .SIGN DUP 0< IF 45 EMIT NEGATE THEN ;\n" /* BUG: 10000000000... will be shown wrong */
+    ": .POS BASE @ /MOD ?DUP IF RECURSE THEN .DIGIT ;\n"
+    ": . .SIGN DUP IF .POS ELSE .DIGIT THEN ;\n"
+    ": COUNTPOS SWAP 1 + SWAP BASE @ / ?DUP IF RECURSE THEN ;\n"
+    ": DIGITS DUP 0< IF 1 ELSE 0 THEN SWAP COUNTPOS ;\n"
+    ": .R OVER DIGITS - SPACES . ;\n"
+    ": . . SPACE ;\n"
+    ": ? @ . ;\n"
+    ": .S DSP@ BEGIN DUP S0@ > WHILE DUP ? CELL - REPEAT DROP ;\n"
+    ": TYPE 0 DO DUP C@ EMIT 1 + LOOP DROP ;\n"
+    ": ALIGN BEGIN HERE @ CELL MOD WHILE 0 C, REPEAT ;\n"
+    ": s\" ' LITSTRING , HERE @ 0 , BEGIN KEY DUP 34 <> WHILE C, REPEAT DROP DUP HERE @ SWAP - CELL - SWAP ! ALIGN ; IMMEDIATE\n"
+    ": .\" [COMPILE] s\" ' TYPE , ; IMMEDIATE\n"
+    ": ( BEGIN KEY [CHAR] ) = UNTIL ; IMMEDIATE\n"
+    ": COUNT DUP 1+ SWAP C@ ;\n"
+    ": MIN 2DUP < IF DROP ELSE NIP THEN ;\n"
+    ": MAX 2DUP > IF DROP ELSE NIP THEN ;\n"
+    ": D0= OR 0= ;\n"
+    ": DMIN 2OVER 2OVER D< IF 2DROP ELSE 2NIP THEN ;\n"
+    ": DMAX 2OVER 2OVER D> IF 2DROP ELSE 2NIP THEN ;\n";
+
+/******************************************************************************/
+
+/* The primary data output function. This is the place to change if you want
+* to e.g. output data on a microcontroller via a serial interface. */
+void
+putkey(char c)
+{
+	putchar(c);
+}
+
+/* The primary data input function. This is where you place the code to e.g.
+* read from a serial line. */
+int
+llkey(void)
+{
+	if(*initscript_pos)
+		return *(initscript_pos++);
+	return getchar();
+}
+
+/* Anything waiting in the keyboard buffer? */
+int
+keyWaiting(void)
+{
+	return positionInLineBuffer < charsInLineBuffer ? -1 : 0;
+}
+
+/* Line buffered character input. We're duplicating the functionality of the
+* stdio library here to make the code easier to port to other input sources */
+int
+getkey(void)
+{
+	int c;
+
+	if(keyWaiting())
+		return lineBuffer[positionInLineBuffer++];
+
+	charsInLineBuffer = 0;
+	while((c = llkey()) != EOF) {
+		if(charsInLineBuffer == sizeof(lineBuffer))
+			break;
+		lineBuffer[charsInLineBuffer++] = c;
+		if(c == '\n')
+			break;
+	}
+
+	positionInLineBuffer = 1;
+	return lineBuffer[0];
+}
+
+/* C string output */
+void
+tell(const char* str)
+{
+	while(*str)
+		putkey(*str++);
+}
+
+/* The basic (data) stack operations */
+
+cell
+pop(void)
+{
+	if(*sp == 1) {
+		tell("? Stack underflow\n");
+		errorFlag = 1;
+		return 0;
+	}
+	return stack[--(*sp)];
+}
+
+cell
+tos(void)
+{
+	if(*sp == 1) {
+		tell("? Stack underflow\n");
+		errorFlag = 1;
+		return 0;
+	}
+	return stack[(*sp) - 1];
+}
+
+void
+push(cell data)
+{
+	if(*sp >= STACK_SIZE) {
+		tell("? Stack overflow\n");
+		errorFlag = 1;
+		return;
+	}
+	stack[(*sp)++] = data;
+}
+
+dcell
+dpop(void)
+{
+	cell tmp[2];
+	tmp[1] = pop();
+	tmp[0] = pop();
+	return *((dcell*)tmp);
+}
+
+void
+dpush(dcell data)
+{
+	cell tmp[2];
+	*((dcell*)tmp) = data;
+	push(tmp[0]);
+	push(tmp[1]);
+}
+
+/* The basic return stack operations */
+
+cell
+rpop(void)
+{
+	if(*rsp == 1) {
+		tell("? RStack underflow\n");
+		errorFlag = 1;
+		return 0;
+	}
+	return rstack[--(*rsp)];
+}
+
+void
+rpush(cell data)
+{
+	if(*rsp >= RSTACK_SIZE) {
+		tell("? RStack overflow\n");
+		errorFlag = 1;
+		return;
+	}
+	rstack[(*rsp)++] = data;
+}
+
+/* Secure memory access */
+
+cell
+readMem(cell address)
+{
+	if(address > MEM_SIZE) {
+		tell("Internal error in readMem: Invalid addres\n");
+		errorFlag = 1;
+		return 0;
+	}
+	return *((cell*)(memory + address));
+}
+
+void
+writeMem(cell address, cell value)
+{
+	if(address > MEM_SIZE) {
+		tell("Internal error in writeMem: Invalid address\n");
+		errorFlag = 1;
+		return;
+	}
+	*((cell*)(memory + address)) = value;
+}
+
+/* Reading a word into the input line buffer */
+byte
+readWord(void)
+{
+	char* line = (char*)memory;
+	byte len = 0;
+	int c;
+
+	while((c = getkey()) != EOF) {
+		if(c == ' ')
+			continue;
+		if(c == '\n')
+			continue;
+		if(c != '\\')
+			break;
+
+		while((c = getkey()) != EOF)
+			if(c == '\n')
+				break;
+	}
+
+	while(c != ' ' && c != '\n' && c != EOF) {
+		if(len >= (INPUT_LINE_SIZE - 1))
+			break;
+		line[++len] = c;
+		c = getkey();
+	}
+	line[0] = len;
+	return len;
+}
+
+/* toupper() clone so we don't have to pull in ctype.h */
+char
+up(char c)
+{
+	return (c >= 'a' && c <= 'z') ? c - 'a' + 'A' : c;
+}
+
+/* Dictionary lookup */
+cell
+findWord(cell address, cell len)
+{
+	cell ret = *latest;
+	char* name = (char*)&memory[address];
+	cell i;
+	int found;
+
+	for(ret = *latest; ret; ret = readMem(ret)) {
+		if((memory[ret + CELL_SIZE] & MASK_NAMELENGTH) != len)
+			continue;
+		if(memory[ret + CELL_SIZE] & FLAG_HIDDEN)
+			continue;
+
+		found = 1;
+		for(i = 0; i < len; i++) {
+			if(up(memory[ret + i + 1 + CELL_SIZE]) != up(name[i])) {
+				found = 0;
+				break;
+			}
+		}
+		if(found)
+			break;
+	}
+	return ret;
+}
+
+/* Basic number parsing, base <= 36 only atm */
+void
+parseNumber(byte* word, cell len, dcell* number, cell* notRead, byte* isDouble)
+{
+	int negative = 0;
+	cell i;
+	char c;
+	cell current;
+
+	*number = 0;
+	*isDouble = 0;
+
+	if(len == 0) {
+		*notRead = 0;
+		return;
+	}
+
+	if(word[0] == '-') {
+		negative = 1;
+		len--;
+		word++;
+	} else if(word[0] == '+') {
+		len--;
+		word++;
+	}
+
+	for(i = 0; i < len; i++) {
+		c = *word;
+		word++;
+		if(c == '.') {
+			*isDouble = 1;
+			continue;
+		} else if(c >= '0' && c <= '9')
+			current = c - '0';
+		else if(c >= 'A' && c <= 'Z')
+			current = 10 + c - 'A';
+		else if(c >= 'a' && c <= 'z')
+			current = 10 + c - 'a';
+		else
+			break;
+
+		if(current >= *base)
+			break;
+
+		*number = *number * *base + current;
+	}
+
+	*notRead = len - i;
+	if(negative)
+		*number = (-((scell)*number));
+}
+
+/*******************************************************************************
+*
+* Builtin definitions
+*
+*******************************************************************************/
+
+BUILTIN(0, "RUNDOCOL", docol, 0)
+{
+	rpush(lastIp);
+	next = commandAddress + CELL_SIZE;
+}
+
+/* The first few builtins are very simple, not need to waste vertical space here */
+BUILTIN(1, "CELL", doCellSize, 0)
+{
+	push(CELL_SIZE);
+}
+BUILTIN(2, "@", memRead, 0)
+{
+	push(readMem(pop()));
+}
+BUILTIN(3, "C@", memReadByte, 0)
+{
+	push(memory[pop()]);
+}
+BUILTIN(4, "KEY", key, 0)
+{
+	push(getkey());
+}
+BUILTIN(5, "EMIT", emit, 0)
+{
+	putkey(pop() & 255);
+}
+BUILTIN(6, "DROP", drop, 0)
+{
+	pop();
+}
+BUILTIN(7, "EXIT", doExit, 0)
+{
+	next = rpop();
+}
+BUILTIN(8, "BYE", bye, 0)
+{
+	exitReq = 1;
+}
+BUILTIN(9, "LATEST", doLatest, 0)
+{
+	push(LATEST_POSITION);
+}
+BUILTIN(10, "HERE", doHere, 0)
+{
+	push(HERE_POSITION);
+}
+BUILTIN(11, "BASE", doBase, 0)
+{
+	push(BASE_POSITION);
+}
+BUILTIN(12, "STATE", doState, 0)
+{
+	push(STATE_POSITION);
+}
+BUILTIN(13, "[", gotoInterpreter, FLAG_IMMEDIATE)
+{
+	*state = 0;
+}
+BUILTIN(14, "]", gotoCompiler, 0)
+{
+	*state = 1;
+}
+BUILTIN(15, "HIDE", hide, 0)
+{
+	memory[*latest + CELL_SIZE] ^= FLAG_HIDDEN;
+}
+BUILTIN(16, "R>", rtos, 0)
+{
+	push(rpop());
+}
+BUILTIN(17, ">R", stor, 0)
+{
+	rpush(pop());
+}
+BUILTIN(18, "KEY?", key_p, 0)
+{
+	push(keyWaiting());
+}
+BUILTIN(19, "BRANCH", branch, 0)
+{
+	next += readMem(next);
+}
+BUILTIN(20, "0BRANCH", zbranch, 0)
+{
+	next += pop() ? CELL_SIZE : readMem(next);
+}
+BUILTIN(21, "IMMEDIATE", toggleImmediate, FLAG_IMMEDIATE)
+{
+	memory[*latest + CELL_SIZE] ^= FLAG_IMMEDIATE;
+}
+BUILTIN(22, "FREE", doFree, 0)
+{
+	push(MEM_SIZE - *here);
+}
+BUILTIN(23, "S0@", s0_r, 0)
+{
+	push(STACK_POSITION + CELL_SIZE);
+}
+BUILTIN(24, "DSP@", dsp_r, 0)
+{
+	push(STACK_POSITION + *sp * CELL_SIZE);
+}
+BUILTIN(25, "NOT", not, 0)
+{
+	push(~pop());
+}
+BUILTIN(26, "DUP", dup, 0)
+{
+	push(tos());
+}
+
+BUILTIN(27, "!", memWrite, 0)
+{
+	cell address = pop();
+	cell value = pop();
+	writeMem(address, value);
+}
+
+BUILTIN(28, "C!", memWriteByte, 0)
+{
+	cell address = pop();
+	cell value = pop();
+	memory[address] = value & 255;
+}
+
+BUILTIN(29, "SWAP", swap, 0)
+{
+	cell a = pop();
+	cell b = pop();
+	push(a);
+	push(b);
+}
+
+BUILTIN(30, "OVER", over, 0)
+{
+	cell a = pop();
+	cell b = tos();
+	push(a);
+	push(b);
+}
+
+BUILTIN(31, ",", comma, 0)
+{
+	push(*here);
+	memWrite();
+	*here += CELL_SIZE;
+}
+
+BUILTIN(32, "C,", commaByte, 0)
+{
+	push(*here);
+	memWriteByte();
+	*here += sizeof(byte);
+}
+
+BUILTIN(33, "WORD", word, 0)
+{
+	byte len = readWord();
+	push(1);
+	push(len);
+}
+
+BUILTIN(34, "FIND", find, 0)
+{
+	cell len = pop();
+	cell address = pop();
+	cell ret = findWord(address, len);
+	push(ret);
+}
+
+cell
+getCfa(cell address)
+{
+	byte len = (memory[address + CELL_SIZE] & MASK_NAMELENGTH) + 1;
+	while((len & (CELL_SIZE - 1)) != 0)
+		len++;
+	return address + CELL_SIZE + len;
+}
+
+BUILTIN(35, ">CFA", cfa, 0)
+{
+	cell address = pop();
+	cell ret = getCfa(address);
+	if(ret < maxBuiltinAddress)
+		push(readMem(ret));
+	else
+		push(ret);
+}
+
+BUILTIN(36, "NUMBER", number, 0)
+{
+	dcell num;
+	cell notRead;
+	byte isDouble;
+	cell len = pop();
+	byte* address = &memory[pop()];
+	parseNumber(address, len, &num, &notRead, &isDouble);
+	if(isDouble)
+		dpush(num);
+	else
+		push((cell)num);
+	push(notRead);
+}
+
+BUILTIN(37, "LIT", lit, 0)
+{
+	push(readMem(next));
+	next += CELL_SIZE;
+}
+
+/* Outer and inner interpreter, TODO split up */
+BUILTIN(38, "QUIT", quit, 0)
+{
+	cell address;
+	dcell number;
+	cell notRead;
+	cell command;
+	int i;
+	byte isDouble;
+	cell tmp[2];
+
+	int immediate;
+
+	for(exitReq = 0; exitReq == 0;) {
+		lastIp = next = quit_address;
+		errorFlag = 0;
+
+		word();
+		find();
+
+		address = pop();
+		if(address) {
+			immediate = (memory[address + CELL_SIZE] & FLAG_IMMEDIATE);
+			commandAddress = getCfa(address);
+			command = readMem(commandAddress);
+			if(*state && !immediate) {
+				if(command < MAX_BUILTIN_ID && command != docol_id)
+					push(command);
+				else
+					push(commandAddress);
+				comma();
+			} else {
+				while(!errorFlag && !exitReq) {
+					if(command == quit_id)
+						break;
+					else if(command < MAX_BUILTIN_ID)
+						builtins[command]();
+					else {
+						lastIp = next;
+						next = command;
+					}
+
+					commandAddress = next;
+					command = readMem(commandAddress);
+					next += CELL_SIZE;
+				}
+			}
+		} else {
+			parseNumber(&memory[1], memory[0], &number, &notRead, &isDouble);
+			if(notRead) {
+				tell("Unknown word: ");
+				for(i = 0; i < memory[0]; i++)
+					putkey(memory[i + 1]);
+				putkey('\n');
+
+				*sp = *rsp = 1;
+				continue;
+			} else {
+				if(*state) {
+					*((dcell*)tmp) = number;
+					push(lit_id);
+					comma();
+
+					if(isDouble) {
+						push(tmp[0]);
+						comma();
+						push(lit_id);
+						comma();
+						push(tmp[1]);
+						comma();
+					} else {
+						push((cell)number);
+						comma();
+					}
+				} else {
+					if(isDouble)
+						dpush(number);
+					else
+						push((cell)number);
+				}
+			}
+		}
+
+		if(errorFlag)
+			*sp = *rsp = 1;
+		else if(!keyWaiting() && !(*initscript_pos))
+			tell(" OK\n");
+	}
+}
+
+BUILTIN(39, "+", plus, 0)
+{
+	scell n1 = pop();
+	scell n2 = pop();
+	push(n1 + n2);
+}
+
+BUILTIN(40, "-", minus, 0)
+{
+	scell n1 = pop();
+	scell n2 = pop();
+	push(n2 - n1);
+}
+
+BUILTIN(41, "*", mul, 0)
+{
+	scell n1 = pop();
+	scell n2 = pop();
+	push(n1 * n2);
+}
+
+BUILTIN(42, "/MOD", divmod, 0)
+{
+	scell n1 = pop();
+	scell n2 = pop();
+	push(n2 % n1);
+	push(n2 / n1);
+}
+
+BUILTIN(43, "ROT", rot, 0)
+{
+	cell a = pop();
+	cell b = pop();
+	cell c = pop();
+	push(b);
+	push(a);
+	push(c);
+}
+
+void createWord(const char* name, byte len, byte flags);
+BUILTIN(44, "CREATE", doCreate, 0)
+{
+	byte len;
+	cell address;
+	word();
+	len = pop() & 255;
+	address = pop();
+	createWord((char*)&memory[address], len, 0);
+}
+
+BUILTIN(45, ":", colon, 0)
+{
+	doCreate();
+	push(docol_id);
+	comma();
+	hide();
+	*state = 1;
+}
+
+BUILTIN(46, ";", semicolon, FLAG_IMMEDIATE)
+{
+	push(doExit_id);
+	comma();
+	hide();
+	*state = 0;
+}
+
+BUILTIN(47, "R@", rget, 0)
+{
+	cell tmp = rpop();
+	rpush(tmp);
+	push(tmp);
+}
+
+BUILTIN(48, "J", doJ, 0)
+{
+	cell tmp1 = rpop();
+	cell tmp2 = rpop();
+	cell tmp3 = rpop();
+	rpush(tmp3);
+	rpush(tmp2);
+	rpush(tmp1);
+	push(tmp3);
+}
+
+BUILTIN(49, "'", tick, FLAG_IMMEDIATE)
+{
+	word();
+	find();
+	cfa();
+
+	if(*state) {
+		push(lit_id);
+		comma();
+		comma();
+	}
+}
+
+BUILTIN(50, "=", equals, 0)
+{
+	cell a1 = pop();
+	cell a2 = pop();
+	push(a2 == a1 ? -1 : 0);
+}
+
+BUILTIN(51, "<", smaller, 0)
+{
+	scell a1 = pop();
+	scell a2 = pop();
+	push(a2 < a1 ? -1 : 0);
+}
+
+BUILTIN(52, ">", larger, 0)
+{
+	scell a1 = pop();
+	scell a2 = pop();
+	push(a2 > a1 ? -1 : 0);
+}
+
+BUILTIN(53, "AND", doAnd, 0)
+{
+	cell a1 = pop();
+	cell a2 = pop();
+	push(a2 & a1);
+}
+
+BUILTIN(54, "OR", doOr, 0)
+{
+	cell a1 = pop();
+	cell a2 = pop();
+	push(a2 | a1);
+}
+
+BUILTIN(55, "?DUP", p_dup, 0)
+{
+	cell a = tos();
+	if(a)
+		push(a);
+}
+
+BUILTIN(56, "LITSTRING", litstring, 0)
+{
+	cell length = readMem(next);
+	next += CELL_SIZE;
+	push(next);
+	push(length);
+	next += length;
+	while(next & (CELL_SIZE - 1))
+		next++;
+}
+
+BUILTIN(57, "XOR", xor, 0)
+{
+	cell a = pop();
+	cell b = pop();
+	push(a ^ b);
+}
+
+BUILTIN(58, "*/", timesDivide, 0)
+{
+	cell n3 = pop();
+	dcell n2 = pop();
+	dcell n1 = pop();
+	dcell r = (n1 * n2) / n3;
+	push((cell)r);
+	if((cell)r != r) {
+		tell("Arithmetic overflow\n");
+		errorFlag = 1;
+	}
+}
+
+BUILTIN(59, "*/MOD", timesDivideMod, 0)
+{
+	cell n3 = pop();
+	dcell n2 = pop();
+	dcell n1 = pop();
+	dcell r = (n1 * n2) / n3;
+	dcell m = (n1 * n2) % n3;
+	push((cell)m);
+	push((cell)r);
+	if((cell)r != r) {
+		tell("Arithmetic overflow\n");
+		errorFlag = 1;
+	}
+}
+
+BUILTIN(60, "D=", dequals, 0)
+{
+	dcell a1 = dpop();
+	dcell a2 = dpop();
+	push(a2 == a1 ? -1 : 0);
+}
+
+BUILTIN(61, "D<", dsmaller, 0)
+{
+	dscell a1 = dpop();
+	dscell a2 = dpop();
+	push(a2 < a1 ? -1 : 0);
+}
+
+BUILTIN(62, "D>", dlarger, 0)
+{
+	dscell a1 = dpop();
+	dscell a2 = dpop();
+	push(a2 > a1 ? -1 : 0);
+}
+
+BUILTIN(63, "DU<", dusmaller, 0)
+{
+	dcell a1 = dpop();
+	dcell a2 = dpop();
+	push(a2 < a1 ? -1 : 0);
+}
+
+BUILTIN(64, "D+", dplus, 0)
+{
+	dscell n1 = dpop();
+	dscell n2 = dpop();
+	dpush(n1 + n2);
+}
+
+BUILTIN(65, "D-", dminus, 0)
+{
+	dscell n1 = dpop();
+	dscell n2 = dpop();
+	dpush(n2 - n1);
+}
+
+BUILTIN(66, "D*", dmul, 0)
+{
+	dscell n1 = dpop();
+	dscell n2 = dpop();
+	dpush(n1 * n2);
+}
+
+BUILTIN(67, "D/", ddiv, 0)
+{
+	dscell n1 = dpop();
+	dscell n2 = dpop();
+	dpush(n2 / n1);
+}
+
+BUILTIN(68, "2SWAP", dswap, 0)
+{
+	dcell a = dpop();
+	dcell b = dpop();
+	dpush(a);
+	dpush(b);
+}
+
+BUILTIN(69, "2OVER", dover, 0)
+{
+	dcell a = dpop();
+	dcell b = dpop();
+	dpush(b);
+	dpush(a);
+	dpush(b);
+}
+
+BUILTIN(70, "2ROT", drot, 0)
+{
+	dcell a = dpop();
+	dcell b = dpop();
+	dcell c = dpop();
+	dpush(b);
+	dpush(a);
+	dpush(c);
+}
+
+/*******************************************************************************
+*
+* Loose ends
+*
+*******************************************************************************/
+
+/* Create a word in the dictionary */
+void
+createWord(const char* name, byte len, byte flags)
+{
+	cell newLatest = *here;
+	push(*latest);
+	comma();
+	push(len | flags);
+	commaByte();
+	while(len--) {
+		push(*name);
+		commaByte();
+		name++;
+	}
+	while(*here & (CELL_SIZE - 1)) {
+		push(0);
+		commaByte();
+	}
+	*latest = newLatest;
+}
+
+/* A simple strlen clone so we don't have to pull in string.h */
+byte
+slen(const char* str)
+{
+	byte ret = 0;
+	while(*str++)
+		ret++;
+	return ret;
+}
+
+/* Add a builtin to the dictionary */
+void
+addBuiltin(cell code, const char* name, const byte flags, builtin f)
+{
+	if(errorFlag)
+		return;
+
+	if(code >= MAX_BUILTIN_ID) {
+		tell("Error adding builtin ");
+		tell(name);
+		tell(": Out of builtin IDs\n");
+		errorFlag = 1;
+		return;
+	}
+
+	if(builtins[code] != 0) {
+		tell("Error adding builtin ");
+		tell(name);
+		tell(": ID given twice\n");
+		errorFlag = 1;
+		return;
+	}
+
+	builtins[code] = f;
+	createWord(name, slen(name), flags);
+	push(code);
+	comma();
+	push(doExit_id);
+	comma();
+}
+
+/* Program setup and jump to outer interpreter */
+int
+main()
+{
+	errorFlag = 0;
+
+	if(DCELL_SIZE != 2 * CELL_SIZE) {
+		tell("Configuration error: DCELL_SIZE != 2*CELL_SIZE\n");
+		return 1;
+	}
+
+	state = (cell*)&memory[STATE_POSITION];
+	base = (cell*)&memory[BASE_POSITION];
+	latest = (cell*)&memory[LATEST_POSITION];
+	here = (cell*)&memory[HERE_POSITION];
+	sp = (cell*)&memory[STACK_POSITION];
+	stack = (cell*)&memory[STACK_POSITION + CELL_SIZE];
+	rsp = (cell*)&memory[RSTACK_POSITION];
+	rstack = (cell*)&memory[RSTACK_POSITION + CELL_SIZE];
+
+	*sp = *rsp = 1;
+	*state = 0;
+	*base = 10;
+	*latest = 0;
+	*here = HERE_START;
+
+	ADD_BUILTIN(docol);
+	ADD_BUILTIN(doCellSize);
+	ADD_BUILTIN(memRead);
+	ADD_BUILTIN(memWrite);
+	ADD_BUILTIN(memReadByte);
+	ADD_BUILTIN(memWriteByte);
+	ADD_BUILTIN(key);
+	ADD_BUILTIN(emit);
+	ADD_BUILTIN(swap);
+	ADD_BUILTIN(dup);
+	ADD_BUILTIN(drop);
+	ADD_BUILTIN(over);
+	ADD_BUILTIN(comma);
+	ADD_BUILTIN(commaByte);
+	ADD_BUILTIN(word);
+	ADD_BUILTIN(find);
+	ADD_BUILTIN(cfa);
+	ADD_BUILTIN(doExit);
+	ADD_BUILTIN(quit);
+	quit_address = getCfa(*latest);
+	ADD_BUILTIN(number);
+	ADD_BUILTIN(bye);
+	ADD_BUILTIN(doLatest);
+	ADD_BUILTIN(doHere);
+	ADD_BUILTIN(doBase);
+	ADD_BUILTIN(doState);
+	ADD_BUILTIN(plus);
+	ADD_BUILTIN(minus);
+	ADD_BUILTIN(mul);
+	ADD_BUILTIN(divmod);
+	ADD_BUILTIN(rot);
+	ADD_BUILTIN(gotoInterpreter);
+	ADD_BUILTIN(gotoCompiler);
+	ADD_BUILTIN(doCreate);
+	ADD_BUILTIN(hide);
+	ADD_BUILTIN(lit);
+	ADD_BUILTIN(colon);
+	ADD_BUILTIN(semicolon);
+	ADD_BUILTIN(rtos);
+	ADD_BUILTIN(stor);
+	ADD_BUILTIN(rget);
+	ADD_BUILTIN(doJ);
+	ADD_BUILTIN(tick);
+	ADD_BUILTIN(key_p);
+	ADD_BUILTIN(equals);
+	ADD_BUILTIN(smaller);
+	ADD_BUILTIN(larger);
+	ADD_BUILTIN(doAnd);
+	ADD_BUILTIN(doOr);
+	ADD_BUILTIN(branch);
+	ADD_BUILTIN(zbranch);
+	ADD_BUILTIN(toggleImmediate);
+	ADD_BUILTIN(doFree);
+	ADD_BUILTIN(p_dup);
+	ADD_BUILTIN(s0_r);
+	ADD_BUILTIN(dsp_r);
+	ADD_BUILTIN(litstring);
+	ADD_BUILTIN(not );
+	ADD_BUILTIN(xor);
+	ADD_BUILTIN(timesDivide);
+	ADD_BUILTIN(timesDivideMod);
+	ADD_BUILTIN(dequals);
+	ADD_BUILTIN(dsmaller);
+	ADD_BUILTIN(dlarger);
+	ADD_BUILTIN(dusmaller);
+	ADD_BUILTIN(dplus);
+	ADD_BUILTIN(dminus);
+	ADD_BUILTIN(dmul);
+	ADD_BUILTIN(ddiv);
+	ADD_BUILTIN(dswap);
+	ADD_BUILTIN(dover);
+	ADD_BUILTIN(drot);
+
+	maxBuiltinAddress = (*here) - 1;
+
+	if(errorFlag)
+		return 1;
+
+	initscript_pos = (char*)initScript;
+	quit();
+	return 0;
+}
\ No newline at end of file