simpleForth/simpleForth.c

#include <stdio.h>
#include <stddef.h>
#include <stdint.h>
#include <stdlib.h>
#include <string.h>
#include <termios.h>
#include <unistd.h>
#include <fcntl.h>

#define TRACE 0
#define TRACE2 0

#define CELLCOUNT 0x1000
#define CELLL     (sizeof (uintptr_t))

#define FALSE 0
#define TRUE  -1
#define IMM_MASK 0x80

#define INC(lval) do { lval += sizeof (lval); } while (0)
#define DEC(lval) do { lval -= sizeof (lval); } while (0)
#define AT(addr)  (*((Cell *)addr))
#define C_AT(addr) (*((char *)addr))
#define HEADER_AT(addr) ((DictEntry *)( addr ))

#define RPUSH(rval) do {                        \
    AT(FS.RP) = rval;                           \
    DEC(FS.RP);                                 \
  } while (0)

#define RPOP(lval) do {                         \
    INC(FS.RP);                                 \
    lval = AT(FS.RP);                           \
  } while (0)

#define SPUSH(rval) do {                        \
    AT(FS.SP) = rval;                           \
    DEC(FS.SP);                                 \
  } while (0)

#define SPOP(lval) do {                         \
    INC(FS.SP);                                 \
    lval = AT(FS.SP);                           \
  } while (0)

#define NEXT return

typedef uintptr_t Cell;
typedef void (*Code)(void);
typedef Code * XT;

#define HDRNAMESZ 3
typedef struct forthDictEntry DictEntry;
struct forthDictEntry {
  union {
    struct {
      unsigned char nameLength;
      unsigned char nameBegin[HDRNAMESZ];
    };
    Cell padding;
  };
  DictEntry *link;
  Code codeAddress;
};

typedef struct forthState {
  /* Interpreter Registers */
  Cell IP;  /* Interpreter Pointer */
  Cell WP;  /* Word/Work Pointer */
  Cell SP;  /* Argument Stack Pointer */
  Cell RP;  /* Return Stack Pointer */
  Cell DP;  /* Dictionary Pointer */
  int running;
} ForthState;

ForthState FS;
Cell FM[CELLCOUNT];
char TIB[128];

DictEntry **VOCAB = (DictEntry **)&FM[0];
Cell *BASE = &FM[1];
Cell *NUM_TIB = &FM[2];
Cell *TO_IN = &FM[3];
Cell *STATE = &FM[4];

void dumpStack(void) {
  Cell *BOS = (Cell *)(FM + CELLCOUNT - 1);
  Cell *TOS = (Cell *)(FS.SP);
  Cell val;
  int depth = (BOS-TOS);
  int i;
  for (i = 0; i < depth; i++) {
    val = AT(BOS-i);
    fprintf(stderr, "%d: %lu\n", i, val);
  }
}

/*
 * Terminal IO Primitives
 */

void QRX(void) {
  int rv;
  int oldflag, newflag;
  char buf[1];
  struct termios oldt, newt;

  tcgetattr(STDIN_FILENO, &oldt);
  fcntl(STDIN_FILENO, F_GETFL, &oldflag);
  newt = oldt;
  newt.c_lflag &= ~( ICANON | ECHO );
  newflag = oldflag | O_NONBLOCK;

  fcntl(STDIN_FILENO, F_SETFL, newflag);
  tcsetattr(STDIN_FILENO, TCSANOW, &newt);

  rv = read(STDIN_FILENO, buf, 1);

  fcntl(STDIN_FILENO, F_SETFL, oldflag);
  tcsetattr(STDIN_FILENO, TCSANOW, &oldt);

  if (rv == -1 || rv == 0) {
    SPUSH(FALSE);
  } else {
    SPUSH(buf[0]);
    SPUSH(TRUE);
  }
  NEXT;
}

char rxchar(void) {
  int rv;
  char b;
  struct termios oldt, newt;

  tcgetattr(STDIN_FILENO, &oldt);
  newt = oldt;
  newt.c_lflag &= ~( ICANON | ECHO );

  tcsetattr(STDIN_FILENO, TCSANOW, &newt);

  rv = read(STDIN_FILENO, &b, 1);
  //fprintf(stderr, "%d\n\n", b);

  tcsetattr(STDIN_FILENO, TCSANOW, &oldt);

  return b;
}

void txchar(char b) {
  int rv;
  struct termios oldt, newt;

  tcgetattr(STDIN_FILENO, &oldt);
  newt = oldt;
  newt.c_lflag &= ~( ICANON | ECHO );

  tcsetattr(STDIN_FILENO, TCSANOW, &newt);

  rv = write(STDIN_FILENO, &b, 1);

  tcsetattr(STDIN_FILENO, TCSANOW, &oldt);
}

// accept ( a l -- l2 ) Read a string of up to l characters, storing it at a.
//    Return the length of the string actually read.
#define BACKSPACE_IN  127
#define BACKSPACE_OUT 8
void ACCEPT(void) {
  Cell addr, len;
  char *inbuf, in;
  int incount = 0;

  SPOP(len);
  SPOP(addr);
  inbuf = (char*)addr;
  for (;;) {
    in = rxchar();
    switch (in) {
    case BACKSPACE_IN:
      if (incount > 0) {
        txchar(BACKSPACE_OUT);
        txchar(' ');
        txchar(BACKSPACE_OUT);
        incount--;
      }
      break;
    case '\n':
      if (incount > 0) {
        goto finished;
      }
      break;
    default:
      if (incount < (int)len) {
        inbuf[incount] = in;
        incount++;
        txchar(in);
      }
      break;
    }
  }
 finished:
  txchar('\n');
  SPUSH(incount);
  NEXT;
}

// word ( c -- cstring ) Consume the next word in TIB as delimited by c,
//     returning the address of the word as a counted string.
void WORD(void) {
  Cell cell;
  char delim, *ch, *last, *lenp, *strp;

  SPOP(cell);
  delim = cell;

  ch = TIB + *TO_IN;
  last = TIB + *NUM_TIB;
  lenp = (char*)FS.DP;
  strp = lenp + 1;
  *lenp = 0;


  /* skip leading delimiters */
  while (*ch == delim) {
    ch++;
  }

  /* copy to pad area until a delimiter is reached */
  for (;;) {
    if (ch == last) {
      break;
    }
    if (*ch == delim) {
      break;
    }
    *strp = *ch;
    strp++; ch++;
    *lenp += 1;
  }
  *strp = ' ';
  *TO_IN = ch - TIB;
  cell = (Cell)lenp;
  SPUSH(cell);
  NEXT;
}

// emit ( c -- ) display c on the terminal
void EMIT(void) {
  Cell cell;
  char c;
  SPOP(cell);
  c = cell;
  txchar(c);
  NEXT;
}

void NL(void) {
  txchar('\n');
  NEXT;
}

void DOT(void) {
  Cell a;
  char buf[64];
  Cell i;
  SPOP(a);
  sprintf(buf, "%ld", (long)a);
  for (i = 0; i < strlen(buf); i++) {
    txchar(buf[i]);
  }
  txchar('\n');
  NEXT;
}

/*
 * Memory Access Primitives
 */

// @ ( addr -- x ) \ read x from addr
void PEEK(void) {
  Cell addr, val;
  SPOP(addr);
  val = AT(addr);
  SPUSH(val);
  NEXT;
}

// ! ( x addr -- ) \ store x at addr
void POKE(void) {
  Cell addr, val;
  SPOP(addr);
  SPOP(val);
  AT(addr) = val;
  NEXT;
}

// c@ ( addr -- c ) \ read character from addr
void CPEEK(void) {
  Cell addr;
  char c;
  SPOP(addr);
  c = AT(addr);
  SPUSH(c);
  NEXT;
}

/*
 * Stack Manipulation Primitives
 */

// drop ( x -- ) \ drop x from stack
void DROP(void) {
  INC(FS.SP);
  NEXT;
}

// dup ( x -- x x ) \ push a copy of x to stack
void DUP(void) {
  Cell addr, val;
  addr = FS.SP;
  INC(addr);
  val = AT(addr);
  SPUSH(val);
  NEXT;
}

// swap ( x y -- y x ) \ swap top two values on stack
void SWAP(void) {
  Cell vx, vy;
  SPOP(vy);
  SPOP(vx);
  SPUSH(vy);
  SPUSH(vx);
  NEXT;
}

// rot ( x y z -- y z x ) \ rotate-left top 3 values on stack
void ROT(void) {
  Cell vx, vy, vz;
  SPOP(vz);
  SPOP(vy);
  SPOP(vx);
  SPUSH(vy);
  SPUSH(vz);
  SPUSH(vx);
  NEXT;
}

/*
 * Flow Control Primitives
 */

// next ( -- ) \ Decrement index on return stack and exit loop if < 0
void DONEXT(void) {
  AT(FS.RP) -= 1;
  if ((int)AT(FS.RP) < 0) {
    RPOP(FS.RP);
    INC(FS.IP);
  } else {
    FS.IP = AT(FS.IP);
  }
  NEXT;
}

// ?branch ( f -- ) \ Branch if flag is 0
void DOQBRANCH(void) {
  Cell flag;

  SPOP(flag);
  if (flag == FALSE) {
    FS.IP = AT(FS.IP);
  } else {
    INC(FS.IP);
  }
  NEXT;
}

// branch ( -- )  \ Branch to an inline address.
void DOBRANCH(void) {
  FS.IP = AT(FS.IP);
  NEXT;
}

/*
 * Compiling Primitives
 */

// , ( x -- ) \ Compile x to the current definition
void COMMA(void) {
  Cell x;
  SPOP(x);
  AT(FS.DP) = x;
  FS.DP += sizeof x;
  NEXT;
}

// c, ( c -- ) \ Compile character c to the current definition
void CCOMMA(void) {
  char c;
  SPOP(c);
  C_AT(FS.DP) = c;
  FS.DP += 1;
  NEXT;
}

/* DOVAR is the machine code for variable definitions. When it is executed, WP
   will be pointing at the codeAddress field of its dictionary entry, so the
   next cell will be the variable cell. DOVAR pushes the address of the variable
   cell to the data stack and */
void DOVAR(void) {
  Cell LP;
  LP = FS.WP;
  INC(LP);
  SPUSH(LP);
  NEXT;
}

// create ( -- ) build a header for a new word in the dictionary, taking the
//     name as the next word in the input buffer
void CREATE(void) {
  DictEntry *newHead = HEADER_AT(FS.DP);
  Cell cell;
  char *name;
  int len;

  SPUSH(' ');
  WORD();
  SPOP(cell);

  name = (char *)(cell + 1);
  len = *(char *)(cell);
#if 0
  fprintf(stderr, "create: nameLength %d, nameBegin '%s'\n",
          newHead->nameLength, newHead->nameBegin);
#endif
  newHead->link = HEADER_AT(*VOCAB);
  newHead->codeAddress = DOVAR;
  *VOCAB = newHead;
  FS.DP += sizeof (DictEntry);
  NEXT;
}

void DOCOL(void);

// : ( -- ) start defining a new word.
void COLON(void) {
  *STATE = -1;
  CREATE();
  (*VOCAB)->codeAddress = DOCOL;
  NEXT;
}

void compileCode(XT codeAddress);
void compileLiteral(Cell literal);
static XT DOEXIT_XT;
// ; ( -- ) finish defining a new word.
void SEMICOLON(void) {
  compileCode(DOEXIT_XT);
  *STATE = 0;
  NEXT;
}

void DOCONST(void);
// constant ( x -- ) create a new constant of value x, with name from input buffer
void CONSTANT(void) {
  Cell value;
  SPOP(value);
  CREATE();
  (*VOCAB)->codeAddress = DOCONST;
  AT(FS.DP) = value;
  FS.DP += sizeof value;
  NEXT;
}

/*
 * Math Primitives
 */

// + ( x y -- z ) \ Push the result of x + y
void PLUS(void) {
  Cell a, b;
  SPOP(a);
  SPOP(b);
  a = a + b;
  SPUSH(a);
  NEXT;
}

// = ( x y -- f ) \ Push true if x = y, false otherwise
void EQUALS(void) {
  Cell x, y, f;
  SPOP(y);
  SPOP(x);
  f = (x == y) ? TRUE : FALSE;
  SPUSH(f);
  NEXT;
}

/*
 * String Primitives
 */

// count ( a -- a2 len ) a is addr of counted string; a2 is addr of first char
void COUNT(void) {
  char *a, *a2;
  Cell len, addr;
  SPOP(addr);
  a = (char *)addr;
  len = a[0];
  a2 = a+1;
  SPUSH((Cell)a2);
  SPUSH(len);
}

/* >number ( n a l -- n2 a2 l2 ) Convert string to number; n is starting number,
       a is addr of first char of string, l is number of chars in string. If
       successful, n2 is the converted number, l2 is zero, and a2 points just
       after the last char in the string. If unsuccessful, l2 is the non-zero
       length of the remaining characters in the string, and a2 is the address
       of the character that caused conversion to fail. */
void TONUMBER(void) {
  Cell num, addr, len, num2;
  char *str, *end;
  char convbuf[128];
  SPOP(len);
  SPOP(addr);
  SPOP(num);
  memcpy(convbuf, (char*)addr, len);
  convbuf[len] = '\0';
  str = convbuf;
  num2 = strtol(str, &end, *BASE);
  if (*end == '\0') {
    addr += len;
    num += num2;
    len = 0;
  } else {
    len = len - (end - str);
    addr += len;
  }
  SPUSH(num);
  SPUSH(addr);
  SPUSH(len);
  NEXT;
}

/*
 * Dictionary Lookup Primitive
 */

DictEntry *findWord(int len, char *name, DictEntry *vocab) {
  char length;
  length = (len > HDRNAMESZ) ? HDRNAMESZ : len;
  while (vocab != NULL) {
    if ((vocab->nameLength & ~(IMM_MASK)) == len) {
      if (strncmp(name, (char*)vocab->nameBegin, length) == 0) {
        return vocab;
      }
    }
    vocab = vocab->link;
  }
  return NULL;
}

// find ( cstring -- a2 flag ) look up a word in the dictionary.
//   If found, a2 is XT of the word; flag is 1 for imm, -1 otherwise
//   If not found, a2 is cstring and flag is 0
void FIND(void) {
  Cell cstr;
  int len;
  char *name;
  DictEntry *hdr;

  SPOP(cstr);
  len = ((char*)cstr)[0];
  name = ((char*)cstr)+1;
  hdr = findWord(len, name, *VOCAB);
  if (hdr == NULL) {
    SPUSH(cstr);
    SPUSH(0);
  } else if (hdr->nameLength & IMM_MASK) {
    SPUSH((Cell)&hdr->codeAddress);
    SPUSH(1);
  } else {
    SPUSH((Cell)&hdr->codeAddress);
    SPUSH((Cell)-1);
  }
  NEXT;
}

/*
 * Inner Interpreter Primitives
 */

/* DOCOL pushes IP onto the R stack, sets IP to the next cell after WP, and
   jumps to NEXT */
void DOCOL(void) {
  RPUSH(FS.IP);
  FS.IP = FS.WP;
  INC(FS.IP);
  NEXT;
}

/* EXIT terminates a colon word, popping IP from R stack. */
void EXIT(void) {
  RPOP(FS.IP);
  NEXT;
}

/* DOLIT fetches the value pointed to by IP, pushes it to the data stack, and
   increments IP; it is used for in-line literals in a secondary definition */
void DOLIT(void) {
  Cell L;
  L = AT(FS.IP);
  SPUSH(L);
  INC(FS.IP);
  NEXT;
}
static Code DOLIT_codeAddress = DOLIT;

/* DOCONST is like DOVAR, but it pushes the value of the cell after the codeAddress rather than the address of the cell */
void DOCONST(void) {
  Cell LP, L;
  LP = FS.WP;
  INC(LP);
  L = AT(LP);
  SPUSH(L);
  NEXT;
}

/* BYE instructs the inner interpreter to stop */
void BYE(void) {
  FS.running = 0;
  NEXT;
}

/* NEXT extracts the word address of the next instruction pointed to by IP,
   stores it in WP, and increments IP to the next cell. It then retrieves the
   address stored at the location indicated by WP and jumps to that address. */
void inner_interpreter(void) {
  Code XP;
#if TRACE2
  DictEntry *hdr;
  char buf[HDRNAMESZ+1];
  int sz;
#endif

  while (FS.running) {
    /* The body of this loop constitutes NEXT */
    FS.WP = AT(FS.IP);
#if TRACE2
    if (FS.WP == (Cell)&DOLIT_codeAddress) {
      memcpy(buf, "LIT", 4);
    } else {
      hdr = HEADER_AT(FS.WP-(2* sizeof (Cell)));
      sz = hdr->nameLength; sz = (sz > HDRNAMESZ) ? HDRNAMESZ : sz;
      memcpy(buf, hdr->nameBegin, sz); buf[sz] = '\0';
    }
    fprintf(stderr, "-----------------\n");
    fprintf(stderr, "\nExecuting word %s\n", buf);
    fprintf(stderr, "Stack before:\n");
    dumpStack();
#endif
    INC(FS.IP);
    XP = (Code)AT(FS.WP);
    XP();
#if TRACE2
    fprintf(stderr, "Stack after:\n");
    dumpStack();
    fprintf(stderr, "-----------------\n");
#endif
  }
}

/* EXECUTE pops a code address from the data stack into the IP, and jumps to
   NEXT */
void EXECUTE(void) {
  Code XP;
#if TRACE
  DictEntry *hdr;
  char buf[HDRNAMESZ+1];
  int sz;
#endif

  SPOP(FS.WP);
#if TRACE
  if (FS.WP == (Cell)&DOLIT_codeAddress) {
    memcpy(buf, "LIT", 4);
  } else {
    hdr = HEADER_AT(FS.WP-(2* sizeof (Cell)));
    sz = hdr->nameLength; sz = (sz > HDRNAMESZ) ? HDRNAMESZ : sz;
    memcpy(buf, hdr->nameBegin, sz); buf[sz] = '\0';
  }
  fprintf(stderr, "-----------------\n");
  fprintf(stderr, "EXECUTE: Executing word %s\n", buf);
  fprintf(stderr, "Stack before:\n");
  dumpStack();
#endif
  XP = (Code)AT(FS.WP);
  XP();
#if TRACE
  fprintf(stderr, "Stack after:\n");
  dumpStack();
  fprintf(stderr, "-----------------\n");
#endif
  NEXT;
}


void compileHeader(const char *name, Code code) {
  DictEntry *newHead = HEADER_AT(FS.DP);
  int i, len;

  len = strlen(name);
  newHead->nameLength = len;
  for (i = 0; i < len && i < HDRNAMESZ; i++) {
    newHead->nameBegin[i] = name[i];
  }
  newHead->link = HEADER_AT(*VOCAB);
  newHead->codeAddress = code;
  *VOCAB = newHead;
  FS.DP += sizeof (DictEntry);
}

void compileCode(XT codeAddress) {
  AT(FS.DP) = (Cell)codeAddress;
  FS.DP += sizeof codeAddress;
}

void compileLiteral(Cell literal) {
  AT(FS.DP) = (Cell)&DOLIT_codeAddress;
  FS.DP += sizeof literal;
  AT(FS.DP) = literal;
  FS.DP += sizeof literal;
}

XT lookupWord(const char *name, DictEntry *vocab) {
  int len;
  DictEntry *hdr;

  len = strlen(name);
  hdr = findWord(len, (char *)name, vocab);
  if (hdr != NULL) {
    return &hdr->codeAddress;
  } else {
    return NULL;
  }
}

void addPrimitive(const char *name, Code code) {
  compileHeader(name, code);
}

void addImmPrimitive(const char *name, Code code) {
  compileHeader(name, code);
  (*VOCAB)->nameLength |= IMM_MASK;
}

void addSecondary(const char *name, const char **words) {
  XT code;
  Cell lit;
  compileHeader(name, DOCOL);
  while (*words != NULL) {
    code = lookupWord(*words, *VOCAB);
    if (code != NULL) {
      compileCode(code);
    } else {
      char *end;
      lit = strtol(*words, &end, 0);
      if (*end == '\0') {
        compileLiteral(lit);
      } else {
        printf("Error adding secondary '%s': '%s' is not in the dictionary"
               " and is not a number\n", name, *words);
        exit(1);
      }
    }
    words++;
  }
  compileCode(lookupWord("EXIT", *VOCAB));
}

void addVariable(const char *name, Cell initVal) {
  compileHeader(name, DOVAR);
  AT(FS.DP) = initVal;
  FS.DP += sizeof initVal;
}

void addConstant(const char *name, Cell value) {
  compileHeader(name, DOCONST);
  AT(FS.DP) = value;
  FS.DP += sizeof value;
}

void ABORT(void) {
  *NUM_TIB = 0;
  *TO_IN = 0;
  *STATE = 0;
  FS.SP = (Cell)(FM + CELLCOUNT - 1);
  FS.RP = (Cell)(FM + CELLCOUNT - 65);

  /* Load IP with the first parameter cell of a secondary. */
  FS.IP = (Cell)((Cell *)lookupWord("COLD", *VOCAB) + 1);
  NEXT;
}

static const char *TEST[] = {
  "40",
  "2",
  "+",
  ".",
  "NL"
};

static const char *TESTWORD[] = {
  "TIB", "128", "ACCEPT",
  "#TIB", "!",
  "0", ">IN", "!",
  "0",
  "32", "WORD",
  "COUNT",
  ">NUMBER", "DROP", "DROP", "NL", ".", "NL",
  0
};

static const char *TESTCREATE[] = {
  "TIB", "128", "ACCEPT",
  "#TIB", "!",
  "0", ">IN", "!",
  "CREATE",
  0
};

static const char *COLD[] = {
  "INTERPRET",
  0
};

Cell cW(const char *name) {
  XT code;
  Cell codeAddr = 0;
  code = lookupWord(name, *VOCAB);
  if (code != NULL) {
    codeAddr = FS.DP;
    compileCode(code);
  } else {
    fprintf(stderr, "Error: %s not in dictionary\n", name);
    exit(1);
  }
  return codeAddr;
}

Cell *cB(const char *name) {
  Cell labelAddr;
  cW(name);
  labelAddr = FS.DP;
  // would code label in here if we knew it
  FS.DP += sizeof (Cell);

  return (Cell *)labelAddr;
}

Cell cL(Cell literal) {
  Cell codeAddr = FS.DP;
  compileLiteral(literal);
  return codeAddr;
}

void buildOuterInterpreter(void) {
  Cell interpt, intpar, intexc, intnf, intnc, intskip, intdone;
  Cell *b_interpt, *b_intpar, *b_intexc, *b_intnf, *b_intnc,
    *b_intskip, *b_intdone, *b_intdone2, *b_intdone3;

  compileHeader("INTERPRET", DOCOL);
  interpt =    cW("#TIB");
               cW("@");
               cW(">IN");
               cW("@");
               cW("=");
  b_intpar =   cB("?BRANCH");
               cW("TIB");
               cL(50);
               cW("ACCEPT");
               cW("#TIB");
               cW("!");
               cL(0);
               cW(">IN");
               cW("!");
  intpar =     cL(32);
               cW("WORD");
               cW("FIND");
               cW("DUP");
  b_intnf =    cB("?BRANCH");
               cW("STATE");
               cW("@");
               cW("=");
  b_intexc =   cB("?BRANCH");
               cW(",");
  b_intdone =  cB("BRANCH");
  intexc =     cW("EXECUTE");
  b_intdone2 = cB("BRANCH");
  intnf =      cW("SWAP");
               cW("COUNT");
               cW(">NUMBER");
  b_intskip =  cB("?BRANCH");
               cW("STATE");
               cW("@");
  b_intnc =    cB("?BRANCH");
               cW("VOCAB");
               cW("@");
               cW("DUP");
               cL(sizeof (Cell));
               cW("+");
               cW("@");
               cW("VOCAB");
               cW("!");
               cL((Cell)&(FS.DP));
               cW("!");
  intnc =      cW("ABORT");
  intskip =    cW("DROP");
               cW("STATE");
               cW("@");
  b_intdone3 = cB("?BRANCH");
               cL((Cell)&DOLIT_codeAddress);
               cW(",");
               cW(",");  intdone = FS.DP;
  b_interpt =  cB("BRANCH");

               cW("EXIT");

  /* Fix up branch targets */
  *b_interpt = interpt;
  *b_intpar = intpar;
  *b_intexc = intexc;
  *b_intnf = intnf;
  *b_intnc = intnc;
  *b_intskip = intskip;
  *b_intdone = intdone;
  *b_intdone2 = intdone;
  *b_intdone3 = intdone;
}

void initialize(void) {
  FS.SP = (Cell)(FM + CELLCOUNT - 1);
  FS.RP = (Cell)(FM + CELLCOUNT - 65);
  FS.DP = (Cell)(FM + 128);
  *VOCAB = NULL;

  /* Inner Interpreter Primitives */
  addPrimitive("EXECUTE", EXECUTE);
  addPrimitive("BYE", BYE);
  addPrimitive("EXIT", EXIT);

  DOEXIT_XT = &(*VOCAB)->codeAddress;

  /* Core address constants */
  addConstant("VOCAB", (Cell)VOCAB);
  addConstant("TIB", (Cell)TIB);
  addConstant("BASE", (Cell)BASE);
  addConstant("TIB", (Cell)TIB);
  addConstant("#TIB", (Cell)NUM_TIB);
  addConstant(">IN", (Cell)TO_IN);
  addConstant("STATE", (Cell)STATE);

  /* Terminal I/O Primitives */
  addPrimitive("ACCEPT", ACCEPT);
  addPrimitive("WORD", WORD);
  addPrimitive("EMIT", EMIT);
  addPrimitive("NL", NL);
  addPrimitive(".", DOT);

  /* Memory Access Primitives */
  addPrimitive("@", PEEK);
  addPrimitive("!", POKE);
  addPrimitive("c@", CPEEK);

  /* Stack Manipulation Primitives */
  addPrimitive("DROP", DROP);
  addPrimitive("DUP", DUP);
  addPrimitive("SWAP", SWAP);
  addPrimitive("ROT", ROT);

  /* Flow Control Primitives */
  addPrimitive("DONEXT", DONEXT);
  addPrimitive("?BRANCH", DOQBRANCH);
  addPrimitive("BRANCH", DOBRANCH);

  /* Compiling Primitives */
  addPrimitive(",", COMMA);
  addPrimitive("c,", CCOMMA);
  addPrimitive("CREATE", CREATE);
  addPrimitive(":", COLON);
  addImmPrimitive(";", SEMICOLON);
  addPrimitive("CONSTANT", CONSTANT);

  /* Math Primitives */
  addPrimitive("+", PLUS);
  addPrimitive("=", EQUALS);

  /* String Primitives */
  addPrimitive("COUNT", COUNT);
  addPrimitive(">NUMBER", TONUMBER);

  /* Dictionary Search Primitives */
  addPrimitive("FIND", FIND);

  /* Outer Interpreter */
  addPrimitive("ABORT", ABORT);
  buildOuterInterpreter();

  /* Extra stuff! */
  addSecondary("TEST", TEST);
  addSecondary("TESTCREATE", TESTCREATE);
  addSecondary("TESTWORD", TESTWORD);
  addSecondary("COLD", COLD);

  /* Load IP with the first parameter cell of a secondary. */
  FS.IP = (Cell)((Cell *)lookupWord("COLD", *VOCAB) + 1);

  /* Set the running state to a true value */
  FS.running = 1;
}

int main(void) {
  initialize();
  inner_interpreter();
  return 0;
}