*

1 files changed, 1124 insertions, 0 deletions

diff --git a/c/lbForth.c b/c/lbForth.c
new file mode 100644
index 0000000..4295434
--- /dev/null
+++ b/c/lbForth.c
@@ -0,0 +1,1124 @@
+/*******************************************************************************
+*
+* A minimal Forth compiler in C
+* By Leif Bruder <leifbruder@gmail.com> http://defineanswer42.wordpress.com
+* Release 2014-04-04
+*
+* 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 int
+#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()
+#define ADD_BUILTIN(c_name) addBuiltin(c_name##_id, c_name##_name, c_name##_flags, c_name)
+typedef void(*builtin)();
+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()
+{
+    if (*initscript_pos) return *(initscript_pos++);
+    return getchar();
+}
+
+/* Anything waiting in the keyboard buffer? */
+int keyWaiting()
+{
+    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()
+{
+    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()
+{
+    if (*sp == 1)
+    {
+        tell("? Stack underflow\n");
+        errorFlag = 1;
+        return 0;
+    }
+    return stack[--(*sp)];
+}
+
+cell tos()
+{
+    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()
+{
+    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()
+{
+    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()
+{
+    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;
+}