Add the Ficl (Forth Inspired Command Language) interpreter. If all goes well,

this will allow us to manage bloat in the loader by using a bytecoded HLL
rather than lots of C code.  It also offers an opportunity for vendors
or others with special applications to significantly customise the boot
process without having to commit to a divergent code branch.

This early commit is to allow others to experiment with the most effective
mechanisms for integrating FICL with the loader as it currently stands.

Ficl is distributed with the following license conditions:

"Ficl is freeware.  Use it in any way that you like, with the understanding
 that the code is not supported."

All source files contain authorship attributions.

Obtained from:	John Sadler (john_sadler@alum.mit.edu)

22 files changed, 9735 insertions, 0 deletions

diff --git a/sys/boot/ficl/Makefile b/sys/boot/ficl/Makefile
new file mode 100644
index 0000000..b3fdd27
--- /dev/null
+++ b/sys/boot/ficl/Makefile
@@ -0,0 +1,23 @@
+# $Id$
+#
+LIB=			ficl
+NOPROFILE=		yes
+INTERNALLIB=		yes
+INTERNALSTATICLIB=	yes
+
+SRCS=			dict.c ficl.c math64.c softcore.c stack.c sysdep.c vm.c words.c
+CLEANFILES=		softcore.c
+
+# Standard softwords
+SOFTWORDS=	softcore.fr jhlocal.fr marker.fr
+# Optional OO extension softwords
+#SOFTWORDS+=	oo.fr classes.fr
+
+.PATH:		${.CURDIR}/softwords
+CFLAGS+=	-I${.CURDIR}
+
+softcore.c:	${SOFTWORDS} softcore.pl
+	(cd ${.CURDIR}/softwords; ./softcore.pl ${SOFTWORDS}) > ${.TARGET}
+
+.include <bsd.lib.mk>
+
diff --git a/sys/boot/ficl/alpha/sysdep.c b/sys/boot/ficl/alpha/sysdep.c
new file mode 100644
index 0000000..e0164f5
--- /dev/null
+++ b/sys/boot/ficl/alpha/sysdep.c
@@ -0,0 +1,90 @@
+/*******************************************************************
+** s y s d e p . c
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+** Implementations of FICL external interface functions... 
+**
+** (simple) port to Linux, Skip Carter 26 March 1998
+**
+*******************************************************************/
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "ficl.h"
+ 
+/*
+*******************  FreeBSD  P O R T   B E G I N S   H E R E ******************** Michael Smith
+*/
+
+UNS64 ficlLongMul(UNS32 x, UNS32 y)
+{
+    UNS64 q;
+    u_int64_t qx;
+
+    qx = (u_int64_t)x * (u_int64_t) y;
+
+    q.hi = (u_int32_t)( qx >> 32 );
+    q.lo = (u_int32_t)( qx & 0xFFFFFFFFL);
+
+    return q;
+}
+
+UNSQR ficlLongDiv(UNS64 q, UNS32 y)
+{
+    UNSQR result;
+    u_int64_t qx, qh;
+
+    qh = q.hi;
+    qx = (qh << 32) | q.lo;
+
+    result.quot = qx / y;
+    result.rem  = qx % y;
+
+    return result;
+}
+
+void  ficlTextOut(FICL_VM *pVM, char *msg, int fNewline)
+{
+    IGNORE(pVM);
+
+    while(*msg != 0)
+	putchar(*(msg++));
+    if (fNewline)
+	putchar('\n');
+
+   return;
+}
+
+void *ficlMalloc (size_t size)
+{
+    return malloc(size);
+}
+
+void  ficlFree   (void *p)
+{
+    free(p);
+}
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** is guaranteed to be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** befor timeout (optional - could also block forever)
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock)
+{
+	IGNORE(fLock);
+	return 0;
+}
+#endif /* FICL_MULTITHREAD */
+
+
diff --git a/sys/boot/ficl/alpha/sysdep.h b/sys/boot/ficl/alpha/sysdep.h
new file mode 100644
index 0000000..4095701
--- /dev/null
+++ b/sys/boot/ficl/alpha/sysdep.h
@@ -0,0 +1,251 @@
+/*******************************************************************
+                    s y s d e p . h
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+** Ficl system dependent types and prototypes...
+**
+** Note: Ficl also depends on the use of "assert" when
+** FICL_ROBUST is enabled. This may require some consideration
+** in firmware systems since assert often
+** assumes stderr/stdout.  
+** 
+*******************************************************************/
+/*
+** N O T I C E -- DISCLAIMER OF WARRANTY
+** 
+** Ficl is freeware. Use it in any way that you like, with
+** the understanding that the code is not supported.
+** 
+** Any third party may reproduce, distribute, or modify the ficl
+** software code or any derivative  works thereof without any 
+** compensation or license, provided that the author information
+** and this disclaimer text are retained in the source code files.
+** The ficl software code is provided on an "as is"  basis without
+** warranty of any kind, including, without limitation, the implied
+** warranties of merchantability and fitness for a particular purpose
+** and their equivalents under the laws of any jurisdiction.  
+** 
+** I am interested in hearing from anyone who uses ficl. If you have
+** a problem, a success story, a defect, an enhancement request, or
+** if you would like to contribute to the ficl release (yay!), please
+** send me email at the address above. 
+*/
+
+#if !defined (__SYSDEP_H__)
+#define __SYSDEP_H__ 
+
+#include <sys/types.h>
+
+#include <stddef.h> /* size_t, NULL */
+#include <setjmp.h>
+
+#include <assert.h>
+
+#if !defined IGNORE		/* Macro to silence unused param warnings */
+#define IGNORE(x) &x
+#endif
+
+
+/*
+** TRUE and FALSE for C boolean operations, and
+** portable 32 bit types for CELLs
+** 
+*/
+#if !defined TRUE
+#define TRUE 1
+#endif
+#if !defined FALSE
+#define FALSE 0
+#endif
+
+
+#if !defined INT32
+#define INT32 int32_t
+#endif
+
+#if !defined UNS32
+#define UNS32 u_int32_t
+#endif
+
+#if !defined UNS16
+#define UNS16 u_int16_t
+#endif
+
+#if !defined UNS8
+#define UNS8 u_int8_t
+#endif
+
+#if !defined NULL
+#define NULL ((void *)0)
+#endif
+
+typedef struct
+{
+    UNS32 hi;
+    UNS32 lo;
+} UNS64;
+
+typedef struct
+{
+    UNS32 quot;
+    UNS32 rem;
+} UNSQR;
+
+typedef struct
+{
+    INT32 hi;
+    INT32 lo;
+} INT64;
+
+typedef struct
+{
+    INT32 quot;
+    INT32 rem;
+} INTQR;
+
+
+/*
+** Build controls
+** FICL_MULTITHREAD enables dictionary mutual exclusion
+** wia the ficlLockDictionary system dependent function.
+*/
+#if !defined FICL_MULTITHREAD
+#define FICL_MULTITHREAD 0
+#endif
+
+/*
+** FICL_ROBUST enables bounds checking of stacks and the dictionary.
+** This will detect stack over and underflows and dictionary overflows.
+** Any exceptional condition will result in an assertion failure.
+** (As generated by the ANSI assert macro)
+** FICL_ROBUST == 1 --> stack checking in the outer interpreter
+** FICL_ROBUST == 2 also enables checking in many primitives
+*/
+
+#if !defined FICL_ROBUST
+#define FICL_ROBUST 2
+#endif
+
+/*
+** FICL_DEFAULT_STACK Specifies the default size (in CELLs) of
+** a new virtual machine's stacks, unless overridden at 
+** create time.
+*/
+#if !defined FICL_DEFAULT_STACK
+#define FICL_DEFAULT_STACK 128
+#endif
+
+/*
+** FICL_DEFAULT_DICT specifies the number of CELLs to allocate
+** for the system dictionary by default. The value
+** can be overridden at startup time as well.
+** FICL_DEFAULT_ENV specifies the number of cells to allot
+** for the environment-query dictionary.
+*/
+#if !defined FICL_DEFAULT_DICT
+#define FICL_DEFAULT_DICT 12288
+#endif
+
+#if !defined FICL_DEFAULT_ENV
+#define FICL_DEFAULT_ENV 260
+#endif
+
+/*
+** FICL_DEFAULT_VOCS specifies the maximum number of wordlists in 
+** the dictionary search order. See Forth DPANS sec 16.3.3
+** (file://dpans16.htm#16.3.3)
+*/
+#if !defined FICL_DEFAULT_VOCS
+#define FICL_DEFAULT_VOCS 16
+#endif
+
+/*
+** User variables: per-instance variables bound to the VM.
+** Kinda like thread-local storage. Could be implemented in a 
+** VM private dictionary, but I've chosen the lower overhead
+** approach of an array of CELLs instead.
+*/
+#if !defined FICL_WANT_USER
+#define FICL_WANT_USER 1
+#endif
+
+#if !defined FICL_USER_CELLS
+#define FICL_USER_CELLS 16
+#endif
+
+/* 
+** FICL_WANT_LOCALS controls the creation of the LOCALS wordset and
+** a private dictionary for local variable compilation.
+*/
+#if !defined FICL_WANT_LOCALS
+#define FICL_WANT_LOCALS 1
+#endif
+
+/* Max number of local variables per definition */
+#if !defined FICL_MAX_LOCALS
+#define FICL_MAX_LOCALS 16
+#endif
+
+/*
+** FICL_ALIGN is the power of two to which the dictionary
+** pointer address must be aligned. This value is usually
+** either 1 or 2, depending on the memory architecture
+** of the target system; 2 is safe on any 16 or 32 bit
+** machine.
+*/
+#if !defined FICL_ALIGN
+#define FICL_ALIGN 2
+#define FICL_ALIGN_ADD ((1 << FICL_ALIGN) - 1)
+#endif
+
+/*
+** System dependent routines --
+** edit the implementations in sysdep.c to be compatible
+** with your runtime environment...
+** ficlTextOut sends a NULL terminated string to the 
+**   default output device - used for system error messages
+** ficlMalloc and ficlFree have the same semantics as malloc and free
+**   in standard C
+** ficlLongMul multiplies two UNS32s and returns a 64 bit unsigned 
+**   product
+** ficlLongDiv divides an UNS64 by an UNS32 and returns UNS32 quotient
+**   and remainder
+*/
+struct vm;
+void  ficlTextOut(struct vm *pVM, char *msg, int fNewline);
+void *ficlMalloc (size_t size);
+void  ficlFree   (void *p);
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** must be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** before timeout (optional - could also block forever)
+**
+** NOTE: this function must be implemented with lock counting
+** semantics: nested calls must behave properly.
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock);
+#else
+#define ficlLockDictionary(x) 0 /* ignore */
+#endif
+
+/*
+** 64 bit integer math support routines: multiply two UNS32s
+** to get a 64 bit prodict, & divide the product by an UNS32
+** to get an UNS32 quotient and remainder. Much easier in asm
+** on a 32 bit CPU than in C, which usually doesn't support 
+** the double length result (but it should).
+*/
+UNS64 ficlLongMul(UNS32 x, UNS32 y);
+UNSQR ficlLongDiv(UNS64 q, UNS32 y);
+
+#endif /*__SYSDEP_H__*/
diff --git a/sys/boot/ficl/dict.c b/sys/boot/ficl/dict.c
new file mode 100644
index 0000000..2e4e436
--- /dev/null
+++ b/sys/boot/ficl/dict.c
@@ -0,0 +1,775 @@
+/*******************************************************************
+** d i c t . c
+** Forth Inspired Command Language - dictionary methods
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 19 July 1997
+** 
+*******************************************************************/
+/*
+** This file implements the dictionary -- FICL's model of 
+** memory management. All FICL words are stored in the
+** dictionary. A word is a named chunk of data with its
+** associated code. FICL treats all words the same, even
+** precompiled ones, so your words become first-class
+** extensions of the language. You can even define new 
+** control structures.
+**
+** 29 jun 1998 (sadler) added variable sized hash table support
+*/
+
+#include <stdlib.h>
+#include <stdio.h>          /* sprintf */
+#include <string.h>
+#include <ctype.h>
+#include "ficl.h"
+
+static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si);
+
+/**************************************************************************
+                        d i c t A b o r t D e f i n i t i o n
+** Abort a definition in process: reclaim its memory and unlink it
+** from the dictionary list. Assumes that there is a smudged 
+** definition in process...otherwise does nothing.
+** NOTE: this function is not smart enough to unlink a word that
+** has been successfully defined (ie linked into a hash). It
+** only works for defs in process. If the def has been unsmudged,
+** nothing happens.
+**************************************************************************/
+void dictAbortDefinition(FICL_DICT *pDict)
+{
+    FICL_WORD *pFW;
+    ficlLockDictionary(TRUE);
+    pFW = pDict->smudge;
+
+    if (pFW->flags & FW_SMUDGE)
+        pDict->here = (CELL *)pFW->name;
+
+    ficlLockDictionary(FALSE);
+    return;
+}
+
+
+/**************************************************************************
+                        a l i g n P t r
+** Aligns the given pointer to FICL_ALIGN address units.
+** Returns the aligned pointer value.
+**************************************************************************/
+void *alignPtr(void *ptr)
+{
+#if FICL_ALIGN > 0
+    char *cp;
+    CELL c;
+    cp = (char *)ptr + FICL_ALIGN_ADD;
+    c.p = (void *)cp;
+    c.u = c.u & (~FICL_ALIGN_ADD);
+    ptr = (CELL *)c.p;
+#endif
+    return ptr;
+}
+
+
+/**************************************************************************
+                        d i c t A l i g n
+** Align the dictionary's free space pointer
+**************************************************************************/
+void dictAlign(FICL_DICT *pDict)
+{
+    pDict->here = alignPtr(pDict->here);
+}
+
+
+/**************************************************************************
+                        d i c t A l l o t
+** Allocate or remove n chars of dictionary space, with
+** checks for underrun and overrun
+**************************************************************************/
+int dictAllot(FICL_DICT *pDict, int n)
+{
+    char *cp = (char *)pDict->here;
+#if FICL_ROBUST
+    if (n > 0)
+    {
+        if ((unsigned)n <= dictCellsAvail(pDict) * sizeof (CELL))
+            cp += n;
+        else
+            return 1;       /* dict is full */
+    }
+    else
+    {
+        n = -n;
+        if ((unsigned)n <= dictCellsUsed(pDict) * sizeof (CELL))
+            cp -= n;
+        else                /* prevent underflow */
+            cp -= dictCellsUsed(pDict) * sizeof (CELL);
+    }
+#else
+    cp += n;
+#endif
+    pDict->here = PTRtoCELL cp;
+    return 0;
+}
+
+
+/**************************************************************************
+                        d i c t A l l o t C e l l s
+** Reserve space for the requested number of cells in the
+** dictionary. If nCells < 0 , removes space from the dictionary.
+**************************************************************************/
+int dictAllotCells(FICL_DICT *pDict, int nCells)
+{
+#if FICL_ROBUST
+    if (nCells > 0)
+    {
+        if (nCells <= dictCellsAvail(pDict))
+            pDict->here += nCells;
+        else
+            return 1;       /* dict is full */
+    }
+    else
+    {
+        nCells = -nCells;
+        if (nCells <= dictCellsUsed(pDict))
+            pDict->here -= nCells;
+        else                /* prevent underflow */
+            pDict->here -= dictCellsUsed(pDict);
+    }
+#else
+    pDict->here += nCells;
+#endif
+    return 0;
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d C e l l
+** Append the specified cell to the dictionary
+**************************************************************************/
+void dictAppendCell(FICL_DICT *pDict, CELL c)
+{
+    *pDict->here++ = c;
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d C h a r
+** Append the specified char to the dictionary
+**************************************************************************/
+void dictAppendChar(FICL_DICT *pDict, char c)
+{
+    char *cp = (char *)pDict->here;
+    *cp++ = c;
+    pDict->here = PTRtoCELL cp;
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d W o r d
+** Create a new word in the dictionary with the specified
+** name, code, and flags. Name must be NULL-terminated.
+**************************************************************************/
+FICL_WORD *dictAppendWord(FICL_DICT *pDict, 
+                          char *name, 
+                          FICL_CODE pCode, 
+                          UNS8 flags)
+{
+    STRINGINFO si;
+    SI_SETLEN(si, strlen(name));
+    SI_SETPTR(si, name);
+    return dictAppendWord2(pDict, si, pCode, flags);
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d W o r d 2
+** Create a new word in the dictionary with the specified
+** STRINGINFO, code, and flags. Does not require a NULL-terminated
+** name.
+**************************************************************************/
+FICL_WORD *dictAppendWord2(FICL_DICT *pDict, 
+                           STRINGINFO si, 
+                           FICL_CODE pCode, 
+                           UNS8 flags)
+{
+    FICL_COUNT len  = (FICL_COUNT)SI_COUNT(si);
+    char *name      = SI_PTR(si);
+    char *pName;
+    FICL_WORD *pFW;
+
+    ficlLockDictionary(TRUE);
+
+    /*
+    ** NOTE: dictCopyName advances "here" as a side-effect.
+    ** It must execute before pFW is initialized.
+    */
+    pName         = dictCopyName(pDict, si);
+    pFW           = (FICL_WORD *)pDict->here;
+    pDict->smudge = pFW;
+    pFW->hash     = hashHashCode(si);
+    pFW->code     = pCode;
+    pFW->flags    = (UNS8)(flags | FW_SMUDGE);
+    pFW->nName    = (char)len;
+    pFW->name     = pName;
+    /*
+    ** Point "here" to first cell of new word's param area...
+    */
+    pDict->here   = pFW->param;
+
+    if (!(flags & FW_SMUDGE))
+        dictUnsmudge(pDict);
+
+    ficlLockDictionary(FALSE);
+    return pFW;
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d U N S 3 2
+** Append the specified UNS32 to the dictionary
+**************************************************************************/
+void dictAppendUNS32(FICL_DICT *pDict, UNS32 u)
+{
+    *pDict->here++ = LVALUEtoCELL(u);
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t C e l l s A v a i l
+** Returns the number of empty cells left in the dictionary
+**************************************************************************/
+int dictCellsAvail(FICL_DICT *pDict)
+{
+    return pDict->size - dictCellsUsed(pDict);
+}
+
+
+/**************************************************************************
+                        d i c t C e l l s U s e d
+** Returns the number of cells consumed in the dicionary
+**************************************************************************/
+int dictCellsUsed(FICL_DICT *pDict)
+{
+    return pDict->here - pDict->dict;
+}
+
+
+/**************************************************************************
+                        d i c t C h e c k
+** Checks the dictionary for corruption and throws appropriate
+** errors
+**************************************************************************/
+void dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int nCells)
+{
+    if ((nCells >= 0) && (dictCellsAvail(pDict) < nCells))
+    {
+        vmThrowErr(pVM, "Error: dictionary full");
+    }
+
+    if ((nCells <= 0) && (dictCellsUsed(pDict) < -nCells))
+    {
+        vmThrowErr(pVM, "Error: dictionary underflow");
+    }
+
+    if (pDict->nLists > FICL_DEFAULT_VOCS)
+    {
+        dictResetSearchOrder(pDict);
+        vmThrowErr(pVM, "Error: search order overflow");
+    }
+    else if (pDict->nLists < 0)
+    {
+        dictResetSearchOrder(pDict);
+        vmThrowErr(pVM, "Error: search order underflow");
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t C o p y N a m e
+** Copy up to nFICLNAME characters of the name specified by si into
+** the dictionary starting at "here", then NULL-terminate the name,
+** point "here" to the next available byte, and return the address of
+** the beginning of the name. Used by dictAppendWord.
+** N O T E S :
+** 1. "here" is guaranteed to be aligned after this operation.
+** 2. If the string has zero length, align and return "here"
+**************************************************************************/
+static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si)
+{
+    char *oldCP    = (char *)pDict->here;
+    char *cp       = oldCP;
+    char *name     = SI_PTR(si);
+    int   i        = SI_COUNT(si);
+
+    if (i == 0)
+    {
+        dictAlign(pDict);
+        return (char *)pDict->here;
+    }
+
+    if (i > nFICLNAME)
+        i = nFICLNAME;
+    
+    for (; i > 0; --i)
+    {
+        *cp++ = *name++;
+    }
+
+    *cp++ = '\0';
+
+    pDict->here = PTRtoCELL cp;
+    dictAlign(pDict);
+    return oldCP;
+}
+
+
+/**************************************************************************
+                        d i c t C r e a t e
+** Create and initialize a dictionary with the specified number
+** of cells capacity, and no hashing (hash size == 1).
+**************************************************************************/
+FICL_DICT  *dictCreate(unsigned nCells)
+{
+    return dictCreateHashed(nCells, 1);
+}
+
+
+FICL_DICT  *dictCreateHashed(unsigned nCells, unsigned nHash)
+{
+    FICL_DICT *pDict;
+    size_t nAlloc;
+
+    nAlloc =  sizeof (FICL_DICT) + nCells      * sizeof (CELL)
+            + sizeof (FICL_HASH) + (nHash - 1) * sizeof (FICL_WORD *);
+
+    pDict = ficlMalloc(nAlloc);
+    assert(pDict);
+    pDict->size = nCells;
+    dictEmpty(pDict, nHash);
+    return pDict;
+}
+
+
+/**************************************************************************
+                        d i c t D e l e t e 
+** Free all memory allocated for the given dictionary 
+**************************************************************************/
+void dictDelete(FICL_DICT *pDict)
+{
+    assert(pDict);
+    ficlFree(pDict);
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t E m p t y
+** Empty the dictionary, reset its hash table, and reset its search order.
+** Clears and (re-)creates the main hash table (pForthWords) with the
+** size specified by nHash.
+**************************************************************************/
+void dictEmpty(FICL_DICT *pDict, unsigned nHash)
+{
+    FICL_HASH *pHash;
+
+    pDict->here = pDict->dict;
+
+    dictAlign(pDict);
+    pHash = (FICL_HASH *)pDict->here;
+    dictAllot(pDict, 
+              sizeof (FICL_HASH) + (nHash - 1) * sizeof (FICL_WORD *));
+
+    pHash->size = nHash;
+    hashReset(pHash);
+
+    pDict->pForthWords = pHash;
+    pDict->smudge = NULL;
+    dictResetSearchOrder(pDict);
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t H a s h S u m m a r y
+** Calculate a figure of merit for the dictionary hash table based
+** on the average search depth for all the words in the dictionary,
+** assuming uniform distribution of target keys. The figure of merit
+** is the ratio of the total search depth for all keys in the table
+** versus a theoretical optimum that would be achieved if the keys
+** were distributed into the table as evenly as possible. 
+** The figure would be worse if the hash table used an open
+** addressing scheme (i.e. collisions resolved by searching the
+** table for an empty slot) for a given size table.
+**************************************************************************/
+void dictHashSummary(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    FICL_HASH *pFHash;
+    FICL_WORD **pHash;
+    unsigned size;
+    FICL_WORD *pFW;
+    unsigned i;
+    int nMax = 0;
+    int nWords = 0;
+    int nFilled;
+    double avg = 0.0;
+    double best;
+    int nAvg, nRem, nDepth;
+
+    dictCheck(dp, pVM, 0);
+
+    pFHash = dp->pSearch[dp->nLists - 1];
+    pHash  = pFHash->table;
+    size   = pFHash->size;
+    nFilled = size;
+
+    for (i = 0; i < size; i++)
+    {
+        int n = 0;
+        pFW = pHash[i];
+
+        while (pFW)
+        {
+            ++n;
+            ++nWords;
+            pFW = pFW->link;
+        }
+
+        avg += (double)(n * (n+1)) / 2.0;
+
+        if (n > nMax)
+            nMax = n;
+        if (n == 0)
+            --nFilled;
+    }
+
+    /* Calc actual avg search depth for this hash */
+    avg = avg / nWords;
+
+    /* Calc best possible performance with this size hash */
+    nAvg = nWords / size;
+    nRem = nWords % size;
+    nDepth = size * (nAvg * (nAvg+1))/2 + (nAvg+1)*nRem;
+    best = (double)nDepth/nWords;
+
+    sprintf(pVM->pad, 
+        "%d bins, %2.0f%% filled, Depth: Max=%d, Avg=%2.1f, Best=%2.1f, Score: %2.0f%%", 
+        size,
+        (double)nFilled * 100.0 / size, nMax,
+        avg, 
+        best,
+        100.0 * best / avg);
+
+    ficlTextOut(pVM, pVM->pad, 1);
+
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t I n c l u d e s
+** Returns TRUE iff the given pointer is within the address range of 
+** the dictionary.
+**************************************************************************/
+int dictIncludes(FICL_DICT *pDict, void *p)
+{
+    return ((p >= (void *) &pDict->dict)
+        &&  (p <  (void *)(&pDict->dict + pDict->size)) 
+           );
+}
+
+
+/**************************************************************************
+                        d i c t L o o k u p
+** Find the FICL_WORD that matches the given name and length.
+** If found, returns the word's address. Otherwise returns NULL.
+** Uses the search order list to search multiple wordlists.
+**************************************************************************/
+FICL_WORD *dictLookup(FICL_DICT *pDict, STRINGINFO si)
+{
+    FICL_WORD *pFW = NULL;
+    FICL_HASH *pHash;
+    int i;
+    UNS16 hashCode   = hashHashCode(si);
+
+    assert(pDict);
+
+    ficlLockDictionary(1);
+
+    for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
+    {
+        pHash = pDict->pSearch[i];
+        pFW = hashLookup(pHash, si, hashCode);
+    }
+
+    ficlLockDictionary(0);
+    return pFW;
+}
+
+
+/**************************************************************************
+                        d i c t L o o k u p L o c
+** Same as dictLookup, but looks in system locals dictionary first...
+** Assumes locals dictionary has only one wordlist...
+**************************************************************************/
+#if FICL_WANT_LOCALS
+FICL_WORD *dictLookupLoc(FICL_DICT *pDict, STRINGINFO si)
+{
+    FICL_WORD *pFW = NULL;
+    FICL_HASH *pHash = ficlGetLoc()->pForthWords;
+    int i;
+    UNS16 hashCode   = hashHashCode(si);
+
+    assert(pHash);
+    assert(pDict);
+
+    ficlLockDictionary(1);
+    /* 
+    ** check the locals dict first... 
+    */
+    pFW = hashLookup(pHash, si, hashCode);
+
+    /* 
+    ** If no joy, (!pFW) --------------------------v
+    ** iterate over the search list in the main dict 
+    */
+    for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
+    {
+        pHash = pDict->pSearch[i];
+        pFW = hashLookup(pHash, si, hashCode);
+    }
+
+    ficlLockDictionary(0);
+    return pFW;
+}
+#endif
+
+
+/**************************************************************************
+                    d i c t R e s e t S e a r c h O r d e r
+** Initialize the dictionary search order list to sane state
+**************************************************************************/
+void dictResetSearchOrder(FICL_DICT *pDict)
+{
+    assert(pDict);
+    pDict->pCompile = pDict->pForthWords;
+    pDict->nLists = 1;
+    pDict->pSearch[0] = pDict->pForthWords;
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t S e t F l a g s
+** Changes the flags field of the most recently defined word:
+** Set all bits that are ones in the set parameter, clear all bits
+** that are ones in the clr parameter. Clear wins in case the same bit
+** is set in both parameters.
+**************************************************************************/
+void dictSetFlags(FICL_DICT *pDict, UNS8 set, UNS8 clr)
+{
+    assert(pDict->smudge);
+    pDict->smudge->flags |= set;
+    pDict->smudge->flags &= ~clr;
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t S e t I m m e d i a t e 
+** Set the most recently defined word as IMMEDIATE
+**************************************************************************/
+void dictSetImmediate(FICL_DICT *pDict)
+{
+    assert(pDict->smudge);
+    pDict->smudge->flags |= FW_IMMEDIATE;
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t U n s m u d g e 
+** Completes the definition of a word by linking it
+** into the main list
+**************************************************************************/
+void dictUnsmudge(FICL_DICT *pDict)
+{
+    FICL_WORD *pFW = pDict->smudge;
+    FICL_HASH *pHash = pDict->pCompile;
+
+    assert(pHash);
+    assert(pFW);
+    /*
+    ** :noname words never get linked into the list...
+    */
+    if (pFW->nName > 0)
+        hashInsertWord(pHash, pFW);
+    pFW->flags &= ~(FW_SMUDGE);
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t W h e r e
+** Returns the value of the HERE pointer -- the address
+** of the next free cell in the dictionary
+**************************************************************************/
+CELL *dictWhere(FICL_DICT *pDict)
+{
+    return pDict->here;
+}
+
+
+/**************************************************************************
+                        h a s h F o r g e t
+** Unlink all words in the hash that have addresses greater than or
+** equal to the address supplied. Implementation factor for FORGET
+** and MARKER.
+**************************************************************************/
+void hashForget(FICL_HASH *pHash, void *where)
+{
+    FICL_WORD *pWord;
+    unsigned i;
+
+    assert(pHash);
+    assert(where);
+
+    for (i = 0; i < pHash->size; i++)
+    {
+        pWord = pHash->table[i];
+
+        while ((void *)pWord >= where)
+        {
+            pWord = pWord->link;
+        }
+
+        pHash->table[i] = pWord;
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        h a s h H a s h C o d e
+** 
+** Generate a 16 bit hashcode from a character string using a rolling
+** shift and add stolen from PJ Weinberger of Bell Labs fame. Case folds
+** the name before hashing it...
+** N O T E : If string has zero length, returns zero.
+**************************************************************************/
+UNS16 hashHashCode(STRINGINFO si)
+{   
+    /* hashPJW */
+    UNS8 *cp;
+    UNS16 code = (UNS16)si.count;
+    UNS16 shift = 0;
+
+    if (si.count == 0)
+        return 0;
+
+    for (cp = (UNS8 *)si.cp; *cp && si.count; cp++, si.count--)
+    {
+        code = (UNS16)((code << 4) + tolower(*cp));
+        shift = (UNS16)(code & 0xf000);
+        if (shift)
+        {
+            code ^= (UNS16)(shift >> 8);
+            code ^= (UNS16)shift;
+        }
+    }
+
+    return (UNS16)code;
+}
+
+
+/**************************************************************************
+                        h a s h I n s e r t W o r d
+** Put a word into the hash table using the word's hashcode as
+** an index (modulo the table size).
+**************************************************************************/
+void hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW)
+{
+    FICL_WORD **pList;
+
+    assert(pHash);
+    assert(pFW);
+
+    if (pHash->size == 1)
+    {
+        pList = pHash->table;
+    }
+    else
+    {
+        pList = pHash->table + (pFW->hash % pHash->size);
+    }
+
+    pFW->link = *pList;
+    *pList = pFW;
+    return;
+}
+
+
+/**************************************************************************
+                        h a s h L o o k u p
+** Find a name in the hash table given the hashcode and text of the name.
+** Returns the address of the corresponding FICL_WORD if found, 
+** otherwise NULL.
+** Note: outer loop on link field supports inheritance in wordlists.
+** It's not part of ANS Forth - ficl only. hashReset creates wordlists
+** with NULL link fields.
+**************************************************************************/
+FICL_WORD *hashLookup(FICL_HASH *pHash, STRINGINFO si, UNS16 hashCode)
+{
+    FICL_COUNT nCmp = (FICL_COUNT)si.count;
+    FICL_WORD *pFW;
+    UNS16 hashIdx;
+
+    if (nCmp > nFICLNAME)
+        nCmp = nFICLNAME;
+
+    for (; pHash != NULL; pHash = pHash->link)
+    {
+        if (pHash->size > 1)
+            hashIdx = (UNS16)(hashCode % pHash->size);
+        else            /* avoid the modulo op for single threaded lists */
+            hashIdx = 0;
+
+        for (pFW = pHash->table[hashIdx]; pFW; pFW = pFW->link)
+        {
+            if ( (pFW->nName == si.count) 
+                && (!strincmp(si.cp, pFW->name, nCmp)) )
+                return pFW;
+#if FICL_ROBUST
+            assert(pFW != pFW->link);
+#endif
+        }
+    }
+
+    return NULL;
+}
+
+
+/**************************************************************************
+                             h a s h R e s e t
+** Initialize a FICL_HASH to empty state.
+**************************************************************************/
+void hashReset(FICL_HASH *pHash)
+{
+    unsigned i;
+
+    assert(pHash);
+
+    for (i = 0; i < pHash->size; i++)
+    {
+        pHash->table[i] = NULL;
+    }
+
+    pHash->link = NULL;
+    return;
+}
+
+
diff --git a/sys/boot/ficl/ficl.c b/sys/boot/ficl/ficl.c
new file mode 100644
index 0000000..e02f136
--- /dev/null
+++ b/sys/boot/ficl/ficl.c
@@ -0,0 +1,380 @@
+/*******************************************************************
+** f i c l . c
+** Forth Inspired Command Language - external interface
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 19 July 1997
+** 
+*******************************************************************/
+/*
+** This is an ANS Forth interpreter written in C.
+** Ficl uses Forth syntax for its commands, but turns the Forth 
+** model on its head in other respects.
+** Ficl provides facilities for interoperating
+** with programs written in C: C functions can be exported to Ficl,
+** and Ficl commands can be executed via a C calling interface. The
+** interpreter is re-entrant, so it can be used in multiple instances
+** in a multitasking system. Unlike Forth, Ficl's outer interpreter
+** expects a text block as input, and returns to the caller after each
+** text block, so the data pump is somewhere in external code. This
+** is more like TCL than Forth.
+**
+** Code is written in ANSI C for portability. 
+*/
+
+#include <stdlib.h>
+#include <string.h>
+#include "ficl.h"
+
+
+/*
+** Local prototypes
+*/
+
+
+/*
+** System statics
+** The system builds a global dictionary during its start
+** sequence. This is shared by all interpreter instances.
+** Therefore only one instance can update the dictionary
+** at a time. The system imports a locking function that
+** you can override in order to control update access to
+** the dictionary. The function is stubbed out by default,
+** but you can insert one: #define FICL_MULTITHREAD 1
+** and supply your own version of ficlLockDictionary.
+*/
+static FICL_DICT *dp     = NULL;
+static FICL_DICT *envp   = NULL;
+#if FICL_WANT_LOCALS
+static FICL_DICT *localp = NULL;
+#endif
+static FICL_VM   *vmList = NULL;
+
+static int defaultStack = FICL_DEFAULT_STACK;
+static int defaultDict  = FICL_DEFAULT_DICT;
+
+
+/**************************************************************************
+                        f i c l I n i t S y s t e m
+** Binds a global dictionary to the interpreter system. 
+** You specify the address and size of the allocated area.
+** After that, ficl manages it.
+** First step is to set up the static pointers to the area.
+** Then write the "precompiled" portion of the dictionary in.
+** The dictionary needs to be at least large enough to hold the
+** precompiled part. Try 1K cells minimum. Use "words" to find
+** out how much of the dictionary is used at any time.
+**************************************************************************/
+void ficlInitSystem(int nDictCells)
+{
+    if (dp)
+        dictDelete(dp);
+
+    if (envp)
+        dictDelete(envp);
+
+#if FICL_WANT_LOCALS
+    if (localp)
+        dictDelete(localp);
+#endif
+
+    if (nDictCells <= 0)
+        nDictCells = defaultDict;
+
+    dp     = dictCreateHashed((unsigned)nDictCells, HASHSIZE);
+    envp   = dictCreate(      (unsigned)FICL_DEFAULT_ENV);
+#if FICL_WANT_LOCALS
+    /*
+    ** The locals dictionary is only searched while compiling,
+    ** but this is where speed is most important. On the other
+    ** hand, the dictionary gets emptied after each use of locals
+    ** The need to balance search speed with the cost of the empty
+    ** operation led me to select a single-threaded list...
+    */
+    localp = dictCreate(      (unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD);
+#endif
+
+    ficlCompileCore(dp);
+
+    return;
+}
+
+
+/**************************************************************************
+                        f i c l N e w V M
+** Create a new virtual machine and link it into the system list
+** of VMs for later cleanup by ficlTermSystem. If this is the first
+** VM to be created, use it to compile the words in softcore.c
+**************************************************************************/
+FICL_VM *ficlNewVM(void)
+{
+    FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack);
+    pVM->link = vmList;
+
+    /*
+    ** Borrow the first vm to build the soft words in softcore.c
+    */
+    if (vmList == NULL)
+        ficlCompileSoftCore(pVM);
+
+    vmList = pVM;
+    return pVM;
+}
+
+
+/**************************************************************************
+                        f i c l B u i l d
+** Builds a word into the dictionary.
+** Preconditions: system must be initialized, and there must
+** be enough space for the new word's header! Operation is
+** controlled by ficlLockDictionary, so any initialization
+** required by your version of the function (if you overrode
+** it) must be complete at this point.
+** Parameters:
+** name  -- duh, the name of the word
+** code  -- code to execute when the word is invoked - must take a single param
+**          pointer to a FICL_VM
+** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR!
+** 
+**************************************************************************/
+int ficlBuild(char *name, FICL_CODE code, char flags)
+{
+	int err = ficlLockDictionary(TRUE);
+	if (err) return err;
+
+    dictAppendWord(dp, name, code, flags);
+
+	ficlLockDictionary(FALSE);
+	return 0;
+}
+
+
+/**************************************************************************
+                        f i c l E x e c
+** Evaluates a block of input text in the context of the
+** specified interpreter. Emits any requested output to the
+** interpreter's output function.
+**
+** Contains the "inner interpreter" code in a tight loop
+**
+** Returns one of the VM_XXXX codes defined in ficl.h:
+** VM_OUTOFTEXT is the normal exit condition
+** VM_ERREXIT means that the interp encountered a syntax error
+**      and the vm has been reset to recover (some or all
+**      of the text block got ignored
+** VM_USEREXIT means that the user executed the "bye" command
+**      to shut down the interpreter. This would be a good
+**      time to delete the vm, etc -- or you can ignore this
+**      signal.
+**************************************************************************/
+int ficlExec(FICL_VM *pVM, char *pText)
+{
+    int        except;
+    FICL_WORD *tempFW;
+    jmp_buf    vmState;
+    jmp_buf   *oldState;
+    TIB        saveTib;
+
+    assert(pVM);
+
+    vmPushTib(pVM, pText, &saveTib);
+
+    /*
+    ** Save and restore VM's jmp_buf to enable nested calls to ficlExec 
+    */
+    oldState = pVM->pState;
+    pVM->pState = &vmState; /* This has to come before the setjmp! */
+    except = setjmp(vmState);
+
+    switch (except)
+    {
+    case 0:
+        if (pVM->fRestart)
+        {
+            pVM->fRestart = 0;
+            pVM->runningWord->code(pVM);
+        }
+
+        /*
+        ** the mysterious inner interpreter...
+        ** vmThrow gets you out of this loop with a longjmp()
+        */
+        for (;;)
+        {
+            tempFW = *pVM->ip++;
+            /*
+            ** inline code for
+            ** vmExecute(pVM, tempFW);
+            */
+            pVM->runningWord = tempFW;
+            tempFW->code(pVM);
+        }
+
+        break;
+
+    case VM_RESTART:
+        pVM->fRestart = 1;
+        except = VM_OUTOFTEXT;
+        break;
+
+    case VM_OUTOFTEXT:
+        if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0))
+            ficlTextOut(pVM, FICL_PROMPT, 0);
+        break;
+
+    case VM_USEREXIT:
+        break;
+
+    case VM_QUIT:
+        if (pVM->state == COMPILE)
+            dictAbortDefinition(dp);
+        vmQuit(pVM);
+        break;
+
+    case VM_ERREXIT:
+    default:    /* user defined exit code?? */
+        if (pVM->state == COMPILE)
+        {
+            dictAbortDefinition(dp);
+#if FICL_WANT_LOCALS
+            dictEmpty(localp, localp->pForthWords->size);
+#endif
+        }
+        dictResetSearchOrder(dp);
+        vmReset(pVM);
+        break;
+   }
+
+    pVM->pState    = oldState;
+    vmPopTib(pVM, &saveTib);
+    return (except);
+}
+
+
+/**************************************************************************
+                        f i c l L o o k u p
+** Look in the system dictionary for a match to the given name. If
+** found, return the address of the corresponding FICL_WORD. Otherwise
+** return NULL.
+**************************************************************************/
+FICL_WORD *ficlLookup(char *name)
+{
+    STRINGINFO si;
+    SI_PSZ(si, name);
+    return dictLookup(dp, si);
+}
+
+
+/**************************************************************************
+                        f i c l G e t D i c t
+** Returns the address of the system dictionary
+**************************************************************************/
+FICL_DICT *ficlGetDict(void)
+{
+    return dp;
+}
+
+
+/**************************************************************************
+                        f i c l G e t E n v
+** Returns the address of the system environment space
+**************************************************************************/
+FICL_DICT *ficlGetEnv(void)
+{
+    return envp;
+}
+
+
+/**************************************************************************
+                        f i c l S e t E n v
+** Create an environment variable with a one-CELL payload. ficlSetEnvD
+** makes one with a two-CELL payload.
+**************************************************************************/
+void ficlSetEnv(char *name, UNS32 value)
+{
+    STRINGINFO si;
+    FICL_WORD *pFW;
+
+    SI_PSZ(si, name);
+    pFW = dictLookup(envp, si);
+
+    if (pFW == NULL)
+    {
+        dictAppendWord(envp, name, constantParen, FW_DEFAULT);
+        dictAppendCell(envp, LVALUEtoCELL(value));
+    }
+    else
+    {
+        pFW->param[0] = LVALUEtoCELL(value);
+    }
+
+    return;
+}
+
+void ficlSetEnvD(char *name, UNS32 hi, UNS32 lo)
+{
+    FICL_WORD *pFW;
+    STRINGINFO si;
+    SI_PSZ(si, name);
+    pFW = dictLookup(envp, si);
+
+    if (pFW == NULL)
+    {
+        dictAppendWord(envp, name, twoConstParen, FW_DEFAULT);
+        dictAppendCell(envp, LVALUEtoCELL(lo));
+        dictAppendCell(envp, LVALUEtoCELL(hi));
+    }
+    else
+    {
+        pFW->param[0] = LVALUEtoCELL(lo);
+        pFW->param[1] = LVALUEtoCELL(hi);
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        f i c l G e t L o c
+** Returns the address of the system locals dictionary. This dict is
+** only used during compilation, and is shared by all VMs.
+**************************************************************************/
+#if FICL_WANT_LOCALS
+FICL_DICT *ficlGetLoc(void)
+{
+    return localp;
+}
+#endif
+
+
+/**************************************************************************
+                        f i c l T e r m S y s t e m
+** Tear the system down by deleting the dictionaries and all VMs.
+** This saves you from having to keep track of all that stuff.
+**************************************************************************/
+void ficlTermSystem(void)
+{
+    if (dp)
+        dictDelete(dp);
+    dp = NULL;
+
+    if (envp)
+        dictDelete(envp);
+    envp = NULL;
+
+#if FICL_WANT_LOCALS
+    if (localp)
+        dictDelete(localp);
+    localp = NULL;
+#endif
+
+    while (vmList != NULL)
+    {
+        FICL_VM *pVM = vmList;
+        vmList = vmList->link;
+        vmDelete(pVM);
+    }
+
+    return;
+}
+
+
diff --git a/sys/boot/ficl/ficl.h b/sys/boot/ficl/ficl.h
new file mode 100644
index 0000000..9fcce10
--- /dev/null
+++ b/sys/boot/ficl/ficl.h
@@ -0,0 +1,758 @@
+/*******************************************************************
+** f i c l . h
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 19 July 1997
+** 
+*******************************************************************/
+/*
+** N O T I C E -- DISCLAIMER OF WARRANTY
+** 
+** Ficl is freeware. Use it in any way that you like, with
+** the understanding that the code is supported on a "best effort"
+** basis only.
+** 
+** Any third party may reproduce, distribute, or modify the ficl
+** software code or any derivative  works thereof without any 
+** compensation or license, provided that the author information
+** and this disclaimer text are retained in the source code files.
+** The ficl software code is provided on an "as is"  basis without
+** warranty of any kind, including, without limitation, the implied
+** warranties of merchantability and fitness for a particular purpose
+** and their equivalents under the laws of any jurisdiction.  
+** 
+** I am interested in hearing from anyone who uses ficl. If you have
+** a problem, a success story, a defect, an enhancement request, or
+** if you would like to contribute to the ficl release (yay!), please
+** send me email at the address above. 
+*/
+
+#if !defined (__FICL_H__)
+#define __FICL_H__
+/*
+** Ficl (Forth-inspired command language) is an ANS Forth
+** interpreter written in C. Unlike traditional Forths, this
+** interpreter is designed to be embedded into other systems
+** as a command/macro/development prototype language. 
+**
+** Where Forths usually view themselves as the center of the system
+** and expect the rest of the system to be coded in Forth, Ficl
+** acts as a component of the system. It is easy to export 
+** code written in C or ASM to Ficl in the style of TCL, or to invoke
+** Ficl code from a compiled module. This allows you to do incremental
+** development in a way that combines the best features of threaded 
+** languages (rapid development, quick code/test/debug cycle,
+** reasonably fast) with the best features of C (everyone knows it,
+** easier to support large blocks of code, efficient, type checking).
+**
+** Ficl provides facilities for interoperating
+** with programs written in C: C functions can be exported to Ficl,
+** and Ficl commands can be executed via a C calling interface. The
+** interpreter is re-entrant, so it can be used in multiple instances
+** in a multitasking system. Unlike Forth, Ficl's outer interpreter
+** expects a text block as input, and returns to the caller after each
+** text block, so the "data pump" is somewhere in external code. This
+** is more like TCL than Forth, which usually expcets to be at the center
+** of the system, requesting input at its convenience. Each Ficl virtual 
+** machine can be bound to a different I/O channel, and is independent
+** of all others in in the same address space except that all virtual
+** machines share a common dictionary (a sort or open symbol table that
+** defines all of the elements of the language).
+**
+** Code is written in ANSI C for portability. 
+**
+** Summary of Ficl features and constraints:
+** - Standard: Implements the ANSI Forth CORE word set and part 
+**   of the CORE EXT word-set, SEARCH and SEARCH EXT, TOOLS and
+**   TOOLS EXT, LOCAL and LOCAL ext and various extras.
+** - Extensible: you can export code written in Forth, C, 
+**   or asm in a straightforward way. Ficl provides open
+**   facilities for extending the language in an application
+**   specific way. You can even add new control structures!
+** - Ficl and C can interact in two ways: Ficl can encapsulate
+**   C code, or C code can invoke Ficl code.
+** - Thread-safe, re-entrant: The shared system dictionary 
+**   uses a locking mechanism that you can either supply
+**   or stub out to provide exclusive access. Each Ficl
+**   virtual machine has an otherwise complete state, and
+**   each can be bound to a separate I/O channel (or none at all).
+** - Simple encapsulation into existing systems: a basic implementation
+**   requires three function calls (see the example program in testmain.c).
+** - ROMable: Ficl is designed to work in RAM-based and ROM code / RAM data
+**   environments. It does require somewhat more memory than a pure
+**   ROM implementation because it builds its system dictionary in 
+**   RAM at startup time.
+** - Written an ANSI C to be as simple as I can make it to understand,
+**   support, debug, and port. Compiles without complaint at /Az /W4 
+**   (require ANSI C, max warnings) under Microsoft VC++ 5.
+** - Does full 32 bit math (but you need to implement
+**   two mixed precision math primitives (see sysdep.c))
+** - Indirect threaded interpreter is not the fastest kind of
+**   Forth there is (see pForth 68K for a really fast subroutine
+**   threaded interpreter), but it's the cleanest match to a
+**   pure C implementation.
+**
+** P O R T I N G   F i c l
+**
+** To install Ficl on your target system, you need an ANSI C compiler
+** and its runtime library. Inspect the system dependent macros and
+** functions in sysdep.h and sysdep.c and edit them to suit your
+** system. For example, INT16 is a short on some compilers and an
+** int on others. Check the default CELL alignment controlled by
+** FICL_ALIGN. If necessary, add new definitions of ficlMalloc, ficlFree,
+** ficlLockDictionary, and ficlTextOut to work with your operating system.
+** Finally, use testmain.c as a guide to installing the Ficl system and 
+** one or more virtual machines into your code. You do not need to include
+** testmain.c in your build.
+**
+** T o   D o   L i s t
+**
+** 1. Unimplemented system dependent CORE word: key
+** 2. Kludged CORE word: ACCEPT 
+** 3. Dictionary locking is full of holes - only one vm at a time
+**    can alter the dict. 
+** 4. Ficl uses the pad in CORE words - this violates the standard,
+**    but it's cleaner for a multithreaded system. I'll have to make a
+**    second pad for reference by the word PAD to fix this.
+**
+** F o r   M o r e   I n f o r m a t i o n
+**
+** Web home of ficl
+**   http://www.taygeta.com/forth/compilers
+** Check this website for Forth literature (including the ANSI standard)
+**   http://www.taygeta.com/forthlit.html
+** and here for software and more links
+**   http://www.taygeta.com/forth.html
+**
+** Obvious Performance enhancement opportunities
+** Compile speed
+** - work on interpret speed
+** - turn off locals (FICL_WANT_LOCALS)
+** Interpret speed 
+** - Change inner interpreter (and everything else)
+**   so that a definition is a list of pointers to functions
+**   and inline data rather than pointers to words. This gets
+**   rid of vm->runningWord and a level of indirection in the
+**   inner loop. I'll look at it for ficl 3.0
+** - Make the main hash table a bigger prime (HASHSIZE)
+** - FORGET about twiddling the hash function - my experience is
+**   that that is a waste of time.
+** - eliminate the need to pass the pVM parameter on the stack
+**   by dedicating a register to it. Most words need access to the
+**   vm, but the parameter passing overhead can be reduced. One way
+**   requires that the host OS have a task switch callout. Create
+**   a global variable for the running VM and refer to it in words
+**   that need VM access. Alternative: use thread local storage. 
+**   For single threaded implementations, you can just use a global.
+**   The first two solutions create portability problems, so I
+**   haven't considered doing them. Another possibility is to
+**   declare the pVm parameter to be "register", and hope the compiler
+**   pays attention.
+**
+*/
+
+/*
+** Revision History:
+** 27 Aug 1998 (sadler) testing and corrections for LOCALS, LOCALS EXT,
+**  SEARCH / SEARCH EXT, TOOLS / TOOLS EXT. 
+**  Added .X to display in hex, PARSE and PARSE-WORD to supplement WORD,
+**  EMPTY to clear stack.
+**
+** 29 jun 1998 (sadler) added variable sized hash table support
+**  and ANS Forth optional SEARCH & SEARCH EXT word set.
+** 26 May 1998 (sadler) 
+**  FICL_PROMPT macro
+** 14 April 1998 (sadler) V1.04
+**  Ficlwin: Windows version, Skip Carter's Linux port
+** 5 March 1998 (sadler) V1.03
+**  Bug fixes -- passes John Ryan's ANS test suite "core.fr"
+**
+** 24 February 1998 (sadler) V1.02
+** -Fixed bugs in <# # #>
+** -Changed FICL_WORD so that storage for the name characters
+**  can be allocated from the dictionary as needed rather than 
+**  reserving 32 bytes in each word whether needed or not - 
+**  this saved 50% of the dictionary storage requirement.
+** -Added words in testmain for Win32 functions system,chdir,cwd,
+**  also added a word that loads and evaluates a file.
+**
+** December 1997 (sadler)
+** -Added VM_RESTART exception handling in ficlExec -- this lets words
+**  that require additional text to succeed (like :, create, variable...)
+**  recover gracefully from an empty input buffer rather than emitting
+**  an error message. Definitions can span multiple input blocks with
+**  no restrictions.
+** -Changed #include order so that <assert.h> is included in sysdep.h,
+**  and sysdep is included in all other files. This lets you define
+**  NDEBUG in sysdep.h to disable assertions if you want to.
+** -Make PC specific system dependent code conditional on _M_IX86
+**  defined so that ports can coexist in sysdep.h/sysdep.c
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#include "sysdep.h"
+#include <limits.h> /* UCHAR_MAX */
+
+/*
+** Forward declarations... read on.
+*/
+struct ficl_word;
+struct vm;
+struct ficl_dict;
+
+/* 
+** the Good Stuff starts here...
+*/
+#define FICL_VER    "2.02"
+#define FICL_PROMPT "ok> "
+
+/*
+** ANS Forth requires false to be zero, and true to be the ones
+** complement of false... that unifies logical and bitwise operations
+** nicely.
+*/
+#define FICL_TRUE  (0xffffffffL)
+#define FICL_FALSE (0)
+#define FICL_BOOL(x) ((x) ? FICL_TRUE : FICL_FALSE)
+
+
+/*
+** A CELL is the main storage type. It must be large enough
+** to contain a pointer or a scalar. Let's be picky and make
+** a 32 bit cell explicitly...
+*/
+typedef union _cell
+{
+	INT32 i;
+    UNS32 u;
+	void *p;
+} CELL;
+
+/*
+** LVALUEtoCELL does a little pointer trickery to cast any 32 bit
+** lvalue (informal definition: an expression whose result has an
+** address) to CELL. Remember that constants and casts are NOT
+** themselves lvalues!
+*/
+#define LVALUEtoCELL(v) (*(CELL *)&v)
+
+/*
+** PTRtoCELL is a cast through void * intended to satisfy the
+** most outrageously pedantic compiler... (I won't mention 
+** its name)
+*/
+#define PTRtoCELL (CELL *)(void *)
+#define PTRtoSTRING (FICL_STRING *)(void *)
+
+/*
+** Strings in FICL are stored in Pascal style - with a count
+** preceding the text. We'll also NULL-terminate them so that 
+** they work with the usual C lib string functions. (Belt &
+** suspenders? You decide.)
+** STRINGINFO hides the implementation with a couple of
+** macros for use in internal routines.
+*/
+
+typedef unsigned char FICL_COUNT;
+#define FICL_STRING_MAX UCHAR_MAX
+typedef struct _ficl_string
+{
+    FICL_COUNT count;
+    char text[1];
+} FICL_STRING;
+
+typedef struct 
+{
+    UNS32 count;
+    char *cp;
+} STRINGINFO;
+
+#define SI_COUNT(si) (si.count)
+#define SI_PTR(si)   (si.cp)
+#define SI_SETLEN(si, len) (si.count = (UNS32)(len))
+#define SI_SETPTR(si, ptr) (si.cp = (char *)(ptr))
+/* 
+** Init a STRINGINFO from a pointer to NULL-terminated string
+*/
+#define SI_PSZ(si, psz) \
+            {si.cp = psz; si.count = (FICL_COUNT)strlen(psz);}
+/* 
+** Init a STRINGINFO from a pointer to FICL_STRING
+*/
+#define SI_PFS(si, pfs) \
+            {si.cp = pfs->text; si.count = pfs->count;}
+
+/*
+** Ficl uses a this little structure to hold the address of 
+** the block of text it's working on and an index to the next
+** unconsumed character in the string. Traditionally, this is
+** done by a Text Input Buffer, so I've called this struct TIB.
+*/
+typedef struct
+{
+    INT32 index;
+    char *cp;
+} TIB;
+
+
+/*
+** Stacks get heavy use in Ficl and Forth...
+** Each virtual machine implements two of them:
+** one holds parameters (data), and the other holds return
+** addresses and control flow information for the virtual
+** machine. (Note: C's automatic stack is implicitly used,
+** but not modeled because it doesn't need to be...)
+** Here's an abstract type for a stack
+*/
+typedef struct _ficlStack
+{
+    UNS32 nCells;       /* size of the stack */
+    CELL *pFrame;       /* link reg for stack frame */
+    CELL *sp;           /* stack pointer */
+    CELL base[1];       /* Bottom of the stack */
+} FICL_STACK;
+
+/*
+** Stack methods... many map closely to required Forth words.
+*/
+FICL_STACK *stackCreate(unsigned nCells);
+void        stackDelete(FICL_STACK *pStack);
+int         stackDepth (FICL_STACK *pStack);
+void        stackDrop  (FICL_STACK *pStack, int n);
+CELL        stackFetch (FICL_STACK *pStack, int n);
+CELL        stackGetTop(FICL_STACK *pStack);
+void        stackLink  (FICL_STACK *pStack, int nCells);
+void        stackPick  (FICL_STACK *pStack, int n);
+CELL        stackPop   (FICL_STACK *pStack);
+void       *stackPopPtr   (FICL_STACK *pStack);
+UNS32       stackPopUNS32 (FICL_STACK *pStack);
+INT32       stackPopINT32 (FICL_STACK *pStack);
+void        stackPush  (FICL_STACK *pStack, CELL c);
+void        stackPushPtr  (FICL_STACK *pStack, void *ptr);
+void        stackPushUNS32(FICL_STACK *pStack, UNS32 u);
+void        stackPushINT32(FICL_STACK *pStack, INT32 i);
+void        stackReset (FICL_STACK *pStack);
+void        stackRoll  (FICL_STACK *pStack, int n);
+void        stackSetTop(FICL_STACK *pStack, CELL c);
+void        stackStore (FICL_STACK *pStack, int n, CELL c);
+void        stackUnlink(FICL_STACK *pStack);
+
+/* 
+** The virtual machine (VM) contains the state for one interpreter.
+** Defined operations include:
+** Create & initialize
+** Delete
+** Execute a block of text
+** Parse a word out of the input stream
+** Call return, and branch 
+** Text output
+** Throw an exception
+*/
+
+typedef struct ficl_word ** IPTYPE; /* the VM's instruction pointer */
+
+/*
+** Each VM has a placeholder for an output function -
+** this makes it possible to have each VM do I/O
+** through a different device. If you specify no
+** OUTFUNC, it defaults to ficlTextOut.
+*/
+typedef void (*OUTFUNC)(struct vm *pVM, char *text, int fNewline);
+
+/*
+** Each VM operates in one of two non-error states: interpreting
+** or compiling. When interpreting, words are simply executed.
+** When compiling, most words in the input stream have their
+** addresses inserted into the word under construction. Some words
+** (known as IMMEDIATE) are executed in the compile state, too.
+*/
+/* values of STATE */
+#define INTERPRET 0
+#define COMPILE   1
+
+/*
+** The pad is a small scratch area for text manipulation. ANS Forth
+** requires it to hold at least 84 characters.
+*/
+#if !defined nPAD
+#define nPAD 256
+#endif
+
+/* 
+** ANS Forth requires that a word's name contain {1..31} characters.
+*/
+#if !defined nFICLNAME
+#define nFICLNAME		31
+#endif
+
+/*
+** OK - now we can really define the VM...
+*/
+typedef struct vm
+{
+    struct vm      *link;       /* Ficl keeps a VM list for simple teardown */
+    jmp_buf        *pState;     /* crude exception mechanism...     */
+    OUTFUNC         textOut;    /* Output callback - see sysdep.c   */
+    void *          pExtend;    /* vm extension pointer             */
+    short           fRestart;   /* Set TRUE to restart runningWord  */
+    IPTYPE          ip;         /* instruction pointer              */
+    struct ficl_word 
+                   *runningWord;/* address of currently running word (often just *(ip-1) ) */
+    UNS32           state;      /* compiling or interpreting        */
+    UNS32           base;       /* number conversion base           */
+    FICL_STACK     *pStack;     /* param stack                      */
+    FICL_STACK     *rStack;     /* return stack                     */
+    CELL            sourceID;   /* -1 if string, 0 if normal input  */
+    TIB             tib;        /* address of incoming text string  */
+#if FICL_WANT_USER
+    CELL            user[FICL_USER_CELLS];
+#endif
+    char            pad[nPAD];  /* the scratch area (see above)     */
+} FICL_VM;
+
+/*
+** A FICL_CODE points to a function that gets called to help execute
+** a word in the dictionary. It always gets passed a pointer to the
+** running virtual machine, and from there it can get the address
+** of the parameter area of the word it's supposed to operate on.
+** For precompiled words, the code is all there is. For user defined
+** words, the code assumes that the word's parameter area is a list
+** of pointers to the code fields of other words to execute, and
+** may also contain inline data. The first parameter is always
+** a pointer to a code field.
+*/
+typedef void (*FICL_CODE)(FICL_VM *pVm);
+
+/* 
+** Ficl models memory as a contiguous space divided into
+** words in a linked list called the dictionary.
+** A FICL_WORD starts each entry in the list.
+** Version 1.02: space for the name characters is allotted from
+** the dictionary ahead of the word struct - this saves about half 
+** the storage on average with very little runtime cost.
+*/
+typedef struct ficl_word
+{
+    struct ficl_word *link;     /* Previous word in the dictionary      */
+    UNS16 hash;
+    UNS8 flags;                 /* Immediate, Smudge, Compile-only      */
+    FICL_COUNT nName;           /* Number of chars in word name         */
+    char *name;                 /* First nFICLNAME chars of word name   */
+    FICL_CODE code;             /* Native code to execute the word      */
+    CELL param[1];              /* First data cell of the word          */
+} FICL_WORD;
+
+/*
+** Worst-case size of a word header: nFICLNAME chars in name
+*/
+#define CELLS_PER_WORD  \
+    ( (sizeof (FICL_WORD) + nFICLNAME + sizeof (CELL)) \
+                          / (sizeof (CELL)) )
+
+int wordIsImmediate(FICL_WORD *pFW);
+int wordIsCompileOnly(FICL_WORD *pFW);
+
+/* flag values for word header */
+#define FW_IMMEDIATE    1   /* execute me even if compiling */
+#define FW_COMPILE      2   /* error if executed when not compiling */
+#define FW_SMUDGE       4   /* definition in progress - hide me */
+#define FW_CLASS        8   /* Word defines a class */
+
+#define FW_COMPIMMED    (FW_IMMEDIATE | FW_COMPILE)
+#define FW_DEFAULT      0
+
+
+/*
+** Exit codes for vmThrow
+*/
+#define VM_OUTOFTEXT    1   /* hungry - normal exit */
+#define VM_RESTART      2   /* word needs more text to suxcceed - re-run it */
+#define VM_USEREXIT     3   /* user wants to quit */
+#define VM_ERREXIT      4   /* interp found an error */
+#define VM_QUIT         5   /* like errexit, but leave pStack & base alone */
+
+
+void        vmBranchRelative(FICL_VM *pVM, int offset);
+FICL_VM *   vmCreate (FICL_VM *pVM, unsigned nPStack, unsigned nRStack);
+void        vmDelete (FICL_VM *pVM);
+void        vmExecute(FICL_VM *pVM, FICL_WORD *pWord);
+char *      vmGetString(FICL_VM *pVM, FICL_STRING *spDest, char delimiter);
+STRINGINFO  vmGetWord(FICL_VM *pVM);
+STRINGINFO  vmGetWord0(FICL_VM *pVM);
+int         vmGetWordToPad(FICL_VM *pVM);
+STRINGINFO  vmParseString(FICL_VM *pVM, char delimiter);
+void        vmPopIP  (FICL_VM *pVM);
+void        vmPushIP (FICL_VM *pVM, IPTYPE newIP);
+void        vmQuit   (FICL_VM *pVM);
+void        vmReset  (FICL_VM *pVM);
+void        vmSetTextOut(FICL_VM *pVM, OUTFUNC textOut);
+void        vmTextOut(FICL_VM *pVM, char *text, int fNewline);
+void        vmThrow  (FICL_VM *pVM, int except);
+void        vmThrowErr(FICL_VM *pVM, char *fmt, ...);
+
+/*
+** vmCheckStack needs a vm pointer because it might have to say
+** something if it finds a problem. Parms popCells and pushCells
+** correspond to the number of parameters on the left and right of 
+** a word's stack effect comment.
+*/
+void        vmCheckStack(FICL_VM *pVM, int popCells, int pushCells);
+
+/*
+** TIB access routines...
+** ANS forth seems to require the input buffer to be represented 
+** as a pointer to the start of the buffer, and an index to the
+** next character to read.
+** PushTib points the VM to a new input string and optionally
+**  returns a copy of the current state
+** PopTib restores the TIB state given a saved TIB from PushTib
+** GetInBuf returns a pointer to the next unused char of the TIB
+*/
+void        vmPushTib(FICL_VM *pVM, char *text, TIB *pSaveTib);
+void        vmPopTib(FICL_VM *pVM, TIB *pTib);
+#define     vmGetInBuf(pVM) ((pVM)->tib.cp + (pVM)->tib.index)
+#define     vmSetTibIndex(pVM, i) (pVM)->tib.index = i
+#define     vmUpdateTib(pVM, str) (pVM)->tib.index = (str) - (pVM)->tib.cp
+
+/*
+** Generally useful string manipulators omitted by ANSI C...
+** ltoa complements strtol
+*/
+#if defined(_WIN32) && !FICL_MAIN
+/* #SHEESH
+** Why do Microsoft Meatballs insist on contaminating
+** my namespace with their string functions???
+*/
+#pragma warning(disable: 4273)
+#endif
+
+char       *ltoa( INT32 value, char *string, int radix );
+char       *ultoa(UNS32 value, char *string, int radix );
+char        digit_to_char(int value);
+char       *strrev( char *string );
+char       *skipSpace(char *cp);
+char       *caseFold(char *cp);
+int         strincmp(char *cp1, char *cp2, FICL_COUNT count);
+
+#if defined(_WIN32) && !FICL_MAIN
+#pragma warning(default: 4273)
+#endif
+
+/*
+** Ficl hash table - variable size.
+** assert(size > 0)
+** If size is 1, the table degenerates into a linked list.
+** A WORDLIST (see the search order word set in DPANS) is
+** just a pointer to a FICL_HASH in this implementation.
+*/
+#if !defined HASHSIZE /* Default size of hash table. For best */
+#define HASHSIZE 127  /*   performance, use a prime number!   */
+#endif
+
+typedef struct ficl_hash 
+{
+    struct ficl_hash *link;  /* eventual inheritance support */
+    unsigned   size;
+    FICL_WORD *table[1];
+} FICL_HASH;
+
+void        hashForget(FICL_HASH *pHash, void *where);
+UNS16       hashHashCode(STRINGINFO si);
+void        hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW);
+FICL_WORD  *hashLookup(struct ficl_hash *pHash, 
+                       STRINGINFO si, 
+                       UNS16 hashCode);
+void        hashReset(FICL_HASH *pHash);
+
+/*
+** A Dictionary is a linked list of FICL_WORDs. It is also Ficl's
+** memory model. Description of fields:
+**
+** here -- points to the next free byte in the dictionary. This
+**      pointer is forced to be CELL-aligned before a definition is added.
+**      Do not assume any specific alignment otherwise - Use dictAlign().
+**
+** smudge -- pointer to word currently being defined (or last defined word)
+**      If the definition completes successfully, the word will be
+**      linked into the hash table. If unsuccessful, dictUnsmudge
+**      uses this pointer to restore the previous state of the dictionary.
+**      Smudge prevents unintentional recursion as a side-effect: the
+**      dictionary search algo examines only completed definitions, so a 
+**      word cannot invoke itself by name. See the ficl word "recurse".
+**      NOTE: smudge always points to the last word defined. IMMEDIATE
+**      makes use of this fact. Smudge is initially NULL.
+**
+** pForthWords -- pointer to the default wordlist (FICL_HASH).
+**      This is the initial compilation list, and contains all
+**      ficl's precompiled words.
+**
+** pCompile -- compilation wordlist - initially equal to pForthWords
+** pSearch  -- array of pointers to wordlists. Managed as a stack.
+**      Highest index is the first list in the search order.
+** nLists   -- number of lists in pSearch. nLists-1 is the highest 
+**      filled slot in pSearch, and points to the first wordlist
+**      in the search order
+** size -- number of cells in the dictionary (total)
+** dict -- start of data area. Must be at the end of the struct.
+*/
+typedef struct ficl_dict
+{
+    CELL *here;
+    FICL_WORD *smudge;
+    FICL_HASH *pForthWords;
+    FICL_HASH *pCompile;
+    FICL_HASH *pSearch[FICL_DEFAULT_VOCS];
+    int        nLists;
+    unsigned   size;    /* Number of cells in dict (total)*/
+    CELL       dict[1]; /* Base of dictionary memory      */
+} FICL_DICT;
+
+void       *alignPtr(void *ptr);
+void        dictAbortDefinition(FICL_DICT *pDict);
+void        dictAlign(FICL_DICT *pDict);
+int         dictAllot(FICL_DICT *pDict, int n);
+int         dictAllotCells(FICL_DICT *pDict, int nCells);
+void        dictAppendCell(FICL_DICT *pDict, CELL c);
+void        dictAppendChar(FICL_DICT *pDict, char c);
+FICL_WORD  *dictAppendWord(FICL_DICT *pDict, 
+                           char *name, 
+                           FICL_CODE pCode, 
+                           UNS8 flags);
+FICL_WORD  *dictAppendWord2(FICL_DICT *pDict, 
+                           STRINGINFO si, 
+                           FICL_CODE pCode, 
+                           UNS8 flags);
+void        dictAppendUNS32(FICL_DICT *pDict, UNS32 u);
+int         dictCellsAvail(FICL_DICT *pDict);
+int         dictCellsUsed (FICL_DICT *pDict);
+void        dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int nCells);
+FICL_DICT  *dictCreate(unsigned nCELLS);
+FICL_DICT  *dictCreateHashed(unsigned nCells, unsigned nHash);
+void        dictDelete(FICL_DICT *pDict);
+void        dictEmpty(FICL_DICT *pDict, unsigned nHash);
+void        dictHashSummary(FICL_VM *pVM);
+int         dictIncludes(FICL_DICT *pDict, void *p);
+FICL_WORD  *dictLookup(FICL_DICT *pDict, STRINGINFO si);
+#if FICL_WANT_LOCALS
+FICL_WORD  *dictLookupLoc(FICL_DICT *pDict, STRINGINFO si);
+#endif
+void        dictResetSearchOrder(FICL_DICT *pDict);
+void        dictSetFlags(FICL_DICT *pDict, UNS8 set, UNS8 clr);
+void        dictSetImmediate(FICL_DICT *pDict);
+void        dictUnsmudge(FICL_DICT *pDict);
+CELL       *dictWhere(FICL_DICT *pDict);
+
+
+/*
+** External interface to FICL...
+*/
+/* 
+** f i c l I n i t S y s t e m
+** Binds a global dictionary to the interpreter system and initializes
+** the dict to contain the ANSI CORE wordset. 
+** You specify the address and size of the allocated area.
+** After that, ficl manages it.
+** First step is to set up the static pointers to the area.
+** Then write the "precompiled" portion of the dictionary in.
+** The dictionary needs to be at least large enough to hold the
+** precompiled part. Try 1K cells minimum. Use "words" to find
+** out how much of the dictionary is used at any time.
+*/
+void       ficlInitSystem(int nDictCells);
+
+/*
+** f i c l T e r m S y s t e m
+** Deletes the system dictionary and all virtual machines that
+** were created with ficlNewVM (see below). Call this function to
+** reclaim all memory used by the dictionary and VMs.
+*/
+void       ficlTermSystem(void);
+
+/*
+** f i c l E x e c
+** Evaluates a block of input text in the context of the
+** specified interpreter. Emits any requested output to the
+** interpreter's output function
+** Execution returns when the text block has been executed,
+** or an error occurs.
+** Returns one of the VM_XXXX codes defined in ficl.h:
+** VM_OUTOFTEXT is the normal exit condition
+** VM_ERREXIT means that the interp encountered a syntax error
+**      and the vm has been reset to recover (some or all
+**      of the text block got ignored
+** VM_USEREXIT means that the user executed the "bye" command
+**      to shut down the interpreter. This would be a good
+**      time to delete the vm, etc -- or you can ignore this
+**      signal.
+** Preconditions: successful execution of ficlInitSystem,
+**      Successful creation and init of the VM by ficlNewVM (or equiv)
+*/
+int        ficlExec(FICL_VM *pVM, char *pText);
+
+/*
+** Create a new VM from the heap, and link it into the system VM list.
+** Initializes the VM and binds default sized stacks to it. Returns the
+** address of the VM, or NULL if an error occurs.
+** Precondition: successful execution of ficlInitSystem
+*/
+FICL_VM   *ficlNewVM(void);
+
+/*
+** Returns the address of the most recently defined word in the system
+** dictionary with the given name, or NULL if no match.
+** Precondition: successful execution of ficlInitSystem
+*/
+FICL_WORD *ficlLookup(char *name);
+
+/*
+** f i c l G e t D i c t
+** Utility function - returns the address of the system dictionary.
+** Precondition: successful execution of ficlInitSystem
+*/
+FICL_DICT *ficlGetDict(void);
+FICL_DICT *ficlGetEnv(void);
+void       ficlSetEnv(char *name, UNS32 value);
+void       ficlSetEnvD(char *name, UNS32 hi, UNS32 lo);
+#if FICL_WANT_LOCALS
+FICL_DICT *ficlGetLoc(void);
+#endif
+/* 
+** f i c l B u i l d
+** Builds a word into the system default dictionary in a thread-safe way.
+** Preconditions: system must be initialized, and there must
+** be enough space for the new word's header! Operation is
+** controlled by ficlLockDictionary, so any initialization
+** required by your version of the function (if you "overrode"
+** it) must be complete at this point.
+** Parameters:
+** name  -- the name of the word to be built
+** code  -- code to execute when the word is invoked - must take a single param
+**          pointer to a FICL_VM
+** flags -- 0 or more of FW_IMMEDIATE, FW_COMPILE, use bitwise OR! 
+**          Most words can use FW_DEFAULT.
+** nAllot - number of extra cells to allocate in the parameter area (usually zero)
+*/
+int        ficlBuild(char *name, FICL_CODE code, char flags);
+
+/* 
+** f i c l C o m p i l e C o r e
+** Builds the ANS CORE wordset into the dictionary - called by
+** ficlInitSystem - no need to waste dict space by doing it again.
+*/
+void       ficlCompileCore(FICL_DICT *dp);
+void       ficlCompileSoftCore(FICL_VM *pVM);
+
+/*
+** from words.c...
+*/
+void       constantParen(FICL_VM *pVM);
+void       twoConstParen(FICL_VM *pVM);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* __FICL_H__ */
diff --git a/sys/boot/ficl/i386/sysdep.c b/sys/boot/ficl/i386/sysdep.c
new file mode 100644
index 0000000..e0164f5
--- /dev/null
+++ b/sys/boot/ficl/i386/sysdep.c
@@ -0,0 +1,90 @@
+/*******************************************************************
+** s y s d e p . c
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+** Implementations of FICL external interface functions... 
+**
+** (simple) port to Linux, Skip Carter 26 March 1998
+**
+*******************************************************************/
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "ficl.h"
+ 
+/*
+*******************  FreeBSD  P O R T   B E G I N S   H E R E ******************** Michael Smith
+*/
+
+UNS64 ficlLongMul(UNS32 x, UNS32 y)
+{
+    UNS64 q;
+    u_int64_t qx;
+
+    qx = (u_int64_t)x * (u_int64_t) y;
+
+    q.hi = (u_int32_t)( qx >> 32 );
+    q.lo = (u_int32_t)( qx & 0xFFFFFFFFL);
+
+    return q;
+}
+
+UNSQR ficlLongDiv(UNS64 q, UNS32 y)
+{
+    UNSQR result;
+    u_int64_t qx, qh;
+
+    qh = q.hi;
+    qx = (qh << 32) | q.lo;
+
+    result.quot = qx / y;
+    result.rem  = qx % y;
+
+    return result;
+}
+
+void  ficlTextOut(FICL_VM *pVM, char *msg, int fNewline)
+{
+    IGNORE(pVM);
+
+    while(*msg != 0)
+	putchar(*(msg++));
+    if (fNewline)
+	putchar('\n');
+
+   return;
+}
+
+void *ficlMalloc (size_t size)
+{
+    return malloc(size);
+}
+
+void  ficlFree   (void *p)
+{
+    free(p);
+}
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** is guaranteed to be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** befor timeout (optional - could also block forever)
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock)
+{
+	IGNORE(fLock);
+	return 0;
+}
+#endif /* FICL_MULTITHREAD */
+
+
diff --git a/sys/boot/ficl/i386/sysdep.h b/sys/boot/ficl/i386/sysdep.h
new file mode 100644
index 0000000..4095701
--- /dev/null
+++ b/sys/boot/ficl/i386/sysdep.h
@@ -0,0 +1,251 @@
+/*******************************************************************
+                    s y s d e p . h
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+** Ficl system dependent types and prototypes...
+**
+** Note: Ficl also depends on the use of "assert" when
+** FICL_ROBUST is enabled. This may require some consideration
+** in firmware systems since assert often
+** assumes stderr/stdout.  
+** 
+*******************************************************************/
+/*
+** N O T I C E -- DISCLAIMER OF WARRANTY
+** 
+** Ficl is freeware. Use it in any way that you like, with
+** the understanding that the code is not supported.
+** 
+** Any third party may reproduce, distribute, or modify the ficl
+** software code or any derivative  works thereof without any 
+** compensation or license, provided that the author information
+** and this disclaimer text are retained in the source code files.
+** The ficl software code is provided on an "as is"  basis without
+** warranty of any kind, including, without limitation, the implied
+** warranties of merchantability and fitness for a particular purpose
+** and their equivalents under the laws of any jurisdiction.  
+** 
+** I am interested in hearing from anyone who uses ficl. If you have
+** a problem, a success story, a defect, an enhancement request, or
+** if you would like to contribute to the ficl release (yay!), please
+** send me email at the address above. 
+*/
+
+#if !defined (__SYSDEP_H__)
+#define __SYSDEP_H__ 
+
+#include <sys/types.h>
+
+#include <stddef.h> /* size_t, NULL */
+#include <setjmp.h>
+
+#include <assert.h>
+
+#if !defined IGNORE		/* Macro to silence unused param warnings */
+#define IGNORE(x) &x
+#endif
+
+
+/*
+** TRUE and FALSE for C boolean operations, and
+** portable 32 bit types for CELLs
+** 
+*/
+#if !defined TRUE
+#define TRUE 1
+#endif
+#if !defined FALSE
+#define FALSE 0
+#endif
+
+
+#if !defined INT32
+#define INT32 int32_t
+#endif
+
+#if !defined UNS32
+#define UNS32 u_int32_t
+#endif
+
+#if !defined UNS16
+#define UNS16 u_int16_t
+#endif
+
+#if !defined UNS8
+#define UNS8 u_int8_t
+#endif
+
+#if !defined NULL
+#define NULL ((void *)0)
+#endif
+
+typedef struct
+{
+    UNS32 hi;
+    UNS32 lo;
+} UNS64;
+
+typedef struct
+{
+    UNS32 quot;
+    UNS32 rem;
+} UNSQR;
+
+typedef struct
+{
+    INT32 hi;
+    INT32 lo;
+} INT64;
+
+typedef struct
+{
+    INT32 quot;
+    INT32 rem;
+} INTQR;
+
+
+/*
+** Build controls
+** FICL_MULTITHREAD enables dictionary mutual exclusion
+** wia the ficlLockDictionary system dependent function.
+*/
+#if !defined FICL_MULTITHREAD
+#define FICL_MULTITHREAD 0
+#endif
+
+/*
+** FICL_ROBUST enables bounds checking of stacks and the dictionary.
+** This will detect stack over and underflows and dictionary overflows.
+** Any exceptional condition will result in an assertion failure.
+** (As generated by the ANSI assert macro)
+** FICL_ROBUST == 1 --> stack checking in the outer interpreter
+** FICL_ROBUST == 2 also enables checking in many primitives
+*/
+
+#if !defined FICL_ROBUST
+#define FICL_ROBUST 2
+#endif
+
+/*
+** FICL_DEFAULT_STACK Specifies the default size (in CELLs) of
+** a new virtual machine's stacks, unless overridden at 
+** create time.
+*/
+#if !defined FICL_DEFAULT_STACK
+#define FICL_DEFAULT_STACK 128
+#endif
+
+/*
+** FICL_DEFAULT_DICT specifies the number of CELLs to allocate
+** for the system dictionary by default. The value
+** can be overridden at startup time as well.
+** FICL_DEFAULT_ENV specifies the number of cells to allot
+** for the environment-query dictionary.
+*/
+#if !defined FICL_DEFAULT_DICT
+#define FICL_DEFAULT_DICT 12288
+#endif
+
+#if !defined FICL_DEFAULT_ENV
+#define FICL_DEFAULT_ENV 260
+#endif
+
+/*
+** FICL_DEFAULT_VOCS specifies the maximum number of wordlists in 
+** the dictionary search order. See Forth DPANS sec 16.3.3
+** (file://dpans16.htm#16.3.3)
+*/
+#if !defined FICL_DEFAULT_VOCS
+#define FICL_DEFAULT_VOCS 16
+#endif
+
+/*
+** User variables: per-instance variables bound to the VM.
+** Kinda like thread-local storage. Could be implemented in a 
+** VM private dictionary, but I've chosen the lower overhead
+** approach of an array of CELLs instead.
+*/
+#if !defined FICL_WANT_USER
+#define FICL_WANT_USER 1
+#endif
+
+#if !defined FICL_USER_CELLS
+#define FICL_USER_CELLS 16
+#endif
+
+/* 
+** FICL_WANT_LOCALS controls the creation of the LOCALS wordset and
+** a private dictionary for local variable compilation.
+*/
+#if !defined FICL_WANT_LOCALS
+#define FICL_WANT_LOCALS 1
+#endif
+
+/* Max number of local variables per definition */
+#if !defined FICL_MAX_LOCALS
+#define FICL_MAX_LOCALS 16
+#endif
+
+/*
+** FICL_ALIGN is the power of two to which the dictionary
+** pointer address must be aligned. This value is usually
+** either 1 or 2, depending on the memory architecture
+** of the target system; 2 is safe on any 16 or 32 bit
+** machine.
+*/
+#if !defined FICL_ALIGN
+#define FICL_ALIGN 2
+#define FICL_ALIGN_ADD ((1 << FICL_ALIGN) - 1)
+#endif
+
+/*
+** System dependent routines --
+** edit the implementations in sysdep.c to be compatible
+** with your runtime environment...
+** ficlTextOut sends a NULL terminated string to the 
+**   default output device - used for system error messages
+** ficlMalloc and ficlFree have the same semantics as malloc and free
+**   in standard C
+** ficlLongMul multiplies two UNS32s and returns a 64 bit unsigned 
+**   product
+** ficlLongDiv divides an UNS64 by an UNS32 and returns UNS32 quotient
+**   and remainder
+*/
+struct vm;
+void  ficlTextOut(struct vm *pVM, char *msg, int fNewline);
+void *ficlMalloc (size_t size);
+void  ficlFree   (void *p);
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** must be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** before timeout (optional - could also block forever)
+**
+** NOTE: this function must be implemented with lock counting
+** semantics: nested calls must behave properly.
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock);
+#else
+#define ficlLockDictionary(x) 0 /* ignore */
+#endif
+
+/*
+** 64 bit integer math support routines: multiply two UNS32s
+** to get a 64 bit prodict, & divide the product by an UNS32
+** to get an UNS32 quotient and remainder. Much easier in asm
+** on a 32 bit CPU than in C, which usually doesn't support 
+** the double length result (but it should).
+*/
+UNS64 ficlLongMul(UNS32 x, UNS32 y);
+UNSQR ficlLongDiv(UNS64 q, UNS32 y);
+
+#endif /*__SYSDEP_H__*/
diff --git a/sys/boot/ficl/math64.c b/sys/boot/ficl/math64.c
new file mode 100644
index 0000000..e83000a
--- /dev/null
+++ b/sys/boot/ficl/math64.c
@@ -0,0 +1,296 @@
+/*******************************************************************
+** m a t h 6 4 . c
+** Forth Inspired Command Language - 64 bit math support routines
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 25 January 1998
+**
+*******************************************************************/
+
+#include "ficl.h"
+#include "math64.h"
+
+
+/**************************************************************************
+                        m 6 4 A b s
+** Returns the absolute value of an INT64
+**************************************************************************/
+INT64 m64Abs(INT64 x)
+{
+    if (m64IsNegative(x))
+        x = m64Negate(x);
+
+    return x;
+}
+
+
+/**************************************************************************
+                        m 6 4 F l o o r e d D i v I
+** 
+** FROM THE FORTH ANS...
+** Floored division is integer division in which the remainder carries
+** the sign of the divisor or is zero, and the quotient is rounded to
+** its arithmetic floor. Symmetric division is integer division in which
+** the remainder carries the sign of the dividend or is zero and the
+** quotient is the mathematical quotient rounded towards zero or
+** truncated. Examples of each are shown in tables 3.3 and 3.4. 
+** 
+** Table 3.3 - Floored Division Example
+** Dividend        Divisor Remainder       Quotient
+** --------        ------- ---------       --------
+**  10                7       3                1
+** -10                7       4               -2
+**  10               -7      -4               -2
+** -10               -7      -3                1
+** 
+** 
+** Table 3.4 - Symmetric Division Example
+** Dividend        Divisor Remainder       Quotient
+** --------        ------- ---------       --------
+**  10                7       3                1
+** -10                7      -3               -1
+**  10               -7       3               -1
+** -10               -7      -3                1
+**************************************************************************/
+INTQR m64FlooredDivI(INT64 num, INT32 den)
+{
+    INTQR qr;
+    UNSQR uqr;
+    int signRem = 1;
+    int signQuot = 1;
+
+    if (m64IsNegative(num))
+    {
+        num = m64Negate(num);
+        signQuot = -signQuot;
+    }
+
+    if (den < 0)
+    {
+        den      = -den;
+        signRem  = -signRem;
+        signQuot = -signQuot;
+    }
+
+    uqr = ficlLongDiv(m64CastIU(num), (UNS32)den);
+    qr = m64CastQRUI(uqr);
+    if (signQuot < 0)
+    {
+        qr.quot = -qr.quot;
+        if (qr.rem != 0)
+        {
+            qr.quot--;
+            qr.rem = den - qr.rem;
+        }
+    }
+
+    if (signRem < 0)
+        qr.rem = -qr.rem;
+
+    return qr;
+}
+
+
+/**************************************************************************
+                        m 6 4 I s N e g a t i v e
+** Returns TRUE if the specified INT64 has its sign bit set.
+**************************************************************************/
+int m64IsNegative(INT64 x)
+{
+    return (x.hi < 0);
+}
+
+
+/**************************************************************************
+                        m 6 4 M a c
+** Mixed precision multiply and accumulate primitive for number building.
+** Multiplies UNS64 u by UNS32 mul and adds UNS32 add. Mul is typically
+** the numeric base, and add represents a digit to be appended to the 
+** growing number. 
+** Returns the result of the operation
+**************************************************************************/
+UNS64 m64Mac(UNS64 u, UNS32 mul, UNS32 add)
+{
+    UNS64 resultLo = ficlLongMul(u.lo, mul);
+    UNS64 resultHi = ficlLongMul(u.hi, mul);
+    resultLo.hi += resultHi.lo;
+    resultHi.lo = resultLo.lo + add;
+
+    if (resultHi.lo < resultLo.lo)
+        resultLo.hi++;
+
+    resultLo.lo = resultHi.lo;
+
+    return resultLo;
+}
+
+
+/**************************************************************************
+                        m 6 4 M u l I
+** Multiplies a pair of INT32s and returns an INT64 result.
+**************************************************************************/
+INT64 m64MulI(INT32 x, INT32 y)
+{
+    UNS64 prod;
+    int sign = 1;
+
+    if (x < 0)
+    {
+        sign = -sign;
+        x = -x;
+    }
+
+    if (y < 0)
+    {
+        sign = -sign;
+        y = -y;
+    }
+
+    prod = ficlLongMul(x, y);
+    if (sign > 0)
+        return m64CastUI(prod);
+    else
+        return m64Negate(m64CastUI(prod));
+}
+
+
+/**************************************************************************
+                        m 6 4 N e g a t e
+** Negates an INT64 by complementing and incrementing.
+**************************************************************************/
+INT64 m64Negate(INT64 x)
+{
+    x.hi = ~x.hi;
+    x.lo = ~x.lo;
+    x.lo ++;
+    if (x.lo == 0)
+        x.hi++;
+
+    return x;
+}
+
+
+/**************************************************************************
+                        m 6 4 P u s h
+** Push an INT64 onto the specified stack in the order required
+** by ANS Forth (most significant cell on top)
+** These should probably be macros...
+**************************************************************************/
+void  i64Push(FICL_STACK *pStack, INT64 i64)
+{
+    stackPushINT32(pStack, i64.lo);
+    stackPushINT32(pStack, i64.hi);
+    return;
+}
+
+void  u64Push(FICL_STACK *pStack, UNS64 u64)
+{
+    stackPushINT32(pStack, u64.lo);
+    stackPushINT32(pStack, u64.hi);
+    return;
+}
+
+
+/**************************************************************************
+                        m 6 4 P o p
+** Pops an INT64 off the stack in the order required by ANS Forth
+** (most significant cell on top)
+** These should probably be macros...
+**************************************************************************/
+INT64 i64Pop(FICL_STACK *pStack)
+{
+    INT64 ret;
+    ret.hi = stackPopINT32(pStack);
+    ret.lo = stackPopINT32(pStack);
+    return ret;
+}
+
+UNS64 u64Pop(FICL_STACK *pStack)
+{
+    UNS64 ret;
+    ret.hi = stackPopINT32(pStack);
+    ret.lo = stackPopINT32(pStack);
+    return ret;
+}
+
+
+/**************************************************************************
+                        m 6 4 S y m m e t r i c D i v
+** Divide an INT64 by an INT32 and return an INT32 quotient and an INT32
+** remainder. The absolute values of quotient and remainder are not
+** affected by the signs of the numerator and denominator (the operation
+** is symmetric on the number line)
+**************************************************************************/
+INTQR m64SymmetricDivI(INT64 num, INT32 den)
+{
+    INTQR qr;
+    UNSQR uqr;
+    int signRem = 1;
+    int signQuot = 1;
+
+    if (m64IsNegative(num))
+    {
+        num = m64Negate(num);
+        signRem  = -signRem;
+        signQuot = -signQuot;
+    }
+
+    if (den < 0)
+    {
+        den      = -den;
+        signQuot = -signQuot;
+    }
+
+    uqr = ficlLongDiv(m64CastIU(num), (UNS32)den);
+    qr = m64CastQRUI(uqr);
+    if (signRem < 0)
+        qr.rem = -qr.rem;
+
+    if (signQuot < 0)
+        qr.quot = -qr.quot;
+
+    return qr;
+}
+
+
+/**************************************************************************
+                        m 6 4 U M o d
+** Divides an UNS64 by base (an UNS16) and returns an UNS16 remainder.
+** Writes the quotient back to the original UNS64 as a side effect.
+** This operation is typically used to convert an UNS64 to a text string
+** in any base. See words.c:numberSignS, for example.
+** Mechanics: performs 4 ficlLongDivs, each of which produces 16 bits
+** of the quotient. C does not provide a way to divide an UNS32 by an
+** UNS16 and get an UNS32 quotient (ldiv is closest, but it's signed,
+** unfortunately), so I've used ficlLongDiv.
+**************************************************************************/
+UNS16 m64UMod(UNS64 *pUD, UNS16 base)
+{
+    UNS64 ud;
+    UNSQR qr;
+    UNS64 result;
+
+    result.hi = result.lo = 0;
+
+    ud.hi = 0;
+    ud.lo = pUD->hi >> 16;
+    qr = ficlLongDiv(ud, (UNS32)base);
+    result.hi = qr.quot << 16;
+
+    ud.lo = (qr.rem << 16) | (pUD->hi & 0x0000ffff);
+    qr = ficlLongDiv(ud, (UNS32)base);
+    result.hi |= qr.quot & 0x0000ffff;
+
+    ud.lo = (qr.rem << 16) | (pUD->lo >> 16);
+    qr = ficlLongDiv(ud, (UNS32)base);
+    result.lo = qr.quot << 16;
+
+    ud.lo = (qr.rem << 16) | (pUD->lo & 0x0000ffff);
+    qr = ficlLongDiv(ud, (UNS32)base);
+    result.lo |= qr.quot & 0x0000ffff;
+
+    *pUD = result;
+
+    return (UNS16)(qr.rem);
+}
+
+
diff --git a/sys/boot/ficl/math64.h b/sys/boot/ficl/math64.h
new file mode 100644
index 0000000..2b7df37
--- /dev/null
+++ b/sys/boot/ficl/math64.h
@@ -0,0 +1,60 @@
+/*******************************************************************
+** m a t h 6 4 . h
+** Forth Inspired Command Language - 64 bit math support routines
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 25 January 1998
+** 
+*******************************************************************/
+/*
+** N O T I C E -- DISCLAIMER OF WARRANTY
+** 
+** Ficl is freeware. Use it in any way that you like, with
+** the understanding that the code is not supported.
+** 
+** Any third party may reproduce, distribute, or modify the ficl
+** software code or any derivative  works thereof without any 
+** compensation or license, provided that the author information
+** and this disclaimer text are retained in the source code files.
+** The ficl software code is provided on an "as is"  basis without
+** warranty of any kind, including, without limitation, the implied
+** warranties of merchantability and fitness for a particular purpose
+** and their equivalents under the laws of any jurisdiction.  
+** 
+** I am interested in hearing from anyone who uses ficl. If you have
+** a problem, a success story, a defect, an enhancement request, or
+** if you would like to contribute to the ficl release (yay!), please
+** send me email at the address above. 
+*/
+
+#if !defined (__MATH64_H__)
+#define __MATH64_H__
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+INT64 m64Abs(INT64 x);
+int   m64IsNegative(INT64 x);
+UNS64 m64Mac(UNS64 u, UNS32 mul, UNS32 add);
+INT64 m64MulI(INT32 x, INT32 y);
+INT64 m64Negate(INT64 x);
+INTQR m64FlooredDivI(INT64 num, INT32 den);
+void  i64Push(FICL_STACK *pStack, INT64 i64);
+INT64 i64Pop(FICL_STACK *pStack);
+void  u64Push(FICL_STACK *pStack, UNS64 u64);
+UNS64 u64Pop(FICL_STACK *pStack);
+INTQR m64SymmetricDivI(INT64 num, INT32 den);
+UNS16 m64UMod(UNS64 *pUD, UNS16 base);
+
+#define i64Extend(i64) (i64).hi = ((i64).lo < 0) ? -1L : 0 
+#define m64CastIU(i64) (*(UNS64 *)(&(i64)))
+#define m64CastUI(u64) (*(INT64 *)(&(u64)))
+#define m64CastQRIU(iqr) (*(UNSQR *)(&(iqr)))
+#define m64CastQRUI(uqr) (*(INTQR *)(&(uqr)))
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
+
diff --git a/sys/boot/ficl/softwords/classes.fr b/sys/boot/ficl/softwords/classes.fr
new file mode 100644
index 0000000..75dc35a
--- /dev/null
+++ b/sys/boot/ficl/softwords/classes.fr
@@ -0,0 +1,140 @@
+\ ** ficl/softwords/classes.fr
+\ ** F I C L   2 . 0   C L A S S E S
+\ john sadler  1 sep 98
+\ Needs oop.fr
+
+.( loading ficl utility classes ) cr
+also oop definitions
+
+\ REF subclass holds a pointer to an object. It's
+\ mainly for aggregation to help in making data structures.
+\
+object subclass c-ref
+    cell: .class
+    cell: .instance
+
+	: get   ( inst class -- refinst refclass )
+		drop 2@ ;
+	: set   ( refinst refclass inst class -- )
+		drop 2! ;
+end-class
+
+object subclass c-byte
+	char: .payload
+
+	: get  drop c@ ;
+	: set  drop c! ;
+end-class
+
+object subclass c-2byte
+	2 chars: .payload
+
+	: get  drop w@ ;
+	: set  drop w! ;
+end-class
+
+object subclass c-4byte
+	cell: .payload
+
+	: get  drop @ ;
+	: set  drop ! ;
+end-class
+
+
+\ ** C - P T R 
+\ Base class for pointers to scalars (not objects).
+\ Note: use c-ref to make references to objects. C-ptr
+\ subclasses refer to untyped quantities of various sizes.
+
+\ Derived classes must specify the size of the thing
+\ they point to, and supply get and set methods.
+
+\ All derived classes must define the @size method:
+\ @size ( inst class -- addr-units )
+\ Returns the size in address units of the thing the pointer
+\ refers to.
+object subclass c-ptr
+    c-4byte obj: .addr
+
+    \ get the value of the pointer
+    : get-ptr   ( inst class -- addr )
+        c-ptr   => .addr  
+        c-4byte => get  
+    ;
+
+    \ set the pointer to address supplied
+    : set-ptr   ( addr inst class -- )
+        c-ptr   => .addr  
+        c-4byte => set  
+    ;
+
+    \ increment the pointer in place
+    : inc-ptr   ( inst class -- )
+        2dup 2dup                   ( i c i c i c )
+        c-ptr => get-ptr  -rot      ( i c addr i c )
+        --> @size  +  -rot          ( addr' i c )
+        c-ptr => set-ptr
+    ;
+
+    \ decrement the pointer in place
+    : dec-ptr    ( inst class -- )
+        2dup 2dup                   ( i c i c i c )
+        c-ptr => get-ptr  -rot      ( i c addr i c )
+        --> @size  -  -rot          ( addr' i c )
+        c-ptr => set-ptr
+    ;
+
+    \ index the pointer in place
+    : index-ptr   ( index inst class -- )
+        locals| class inst index |
+        inst class  c-ptr => get-ptr        ( addr )
+        inst class --> @size  index *  +    ( addr' )
+        inst class  c-ptr => set-ptr
+    ;
+
+end-class
+
+
+\ ** C - C E L L P T R 
+\ Models a pointer to cell (a 32 bit scalar). 
+c-ptr subclass c-cellPtr
+    : @size   2drop  4  ;
+    \ fetch and store through the pointer
+	: get   ( inst class -- cell )
+        c-ptr => get-ptr @  
+    ;
+	: set   ( value inst class -- )
+        c-ptr => get-ptr !  
+    ;
+end-class
+
+
+\ ** C - 2 B Y T E P T R 
+\ Models a pointer to a 16 bit scalar
+c-ptr subclass c-2bytePtr
+    : @size   2drop  2  ;
+    \ fetch and store through the pointer
+	: get   ( inst class -- value )
+        c-ptr => get-ptr w@  
+    ;
+	: set   ( value inst class -- )
+        c-ptr => get-ptr w!  
+    ;
+end-class
+
+
+\ ** C - B Y T E P T R 
+\ Models a pointer to an 8 bit scalar
+c-ptr subclass c-bytePtr
+    : @size   2drop  1  ;
+    \ fetch and store through the pointer
+	: get   ( inst class -- value )
+        c-ptr => get-ptr c@  
+    ;
+	: set   ( value inst class -- )
+        c-ptr => get-ptr c!  
+    ;
+end-class
+
+
+previous definitions
diff --git a/sys/boot/ficl/softwords/jhlocal.fr b/sys/boot/ficl/softwords/jhlocal.fr
new file mode 100644
index 0000000..034ada5
--- /dev/null
+++ b/sys/boot/ficl/softwords/jhlocal.fr
@@ -0,0 +1,77 @@
+\ #if FICL_WANT_LOCALS
+\ ** ficl/softwords/jhlocal.fr
+\ ** stack comment style local syntax...
+\ { a b c | cleared -- d e }
+\ variables before the "|" are initialized in reverse order
+\ from the stack. Those after the "|" are zero initialized.
+\ Anything between "--" and "}" is treated as comment
+\ Uses locals...
+\ locstate: 0 = looking for | or -- or }}
+\           1 = found |
+\           2 = found --
+hide
+0 constant zero
+
+: ?--   ( c-addr u -- c-addr u flag )
+    2dup s" --" compare 0= ;
+: ?}    ( c-addr u -- c-addr u flag )
+    2dup s" }"  compare 0= ;
+: ?|    ( c-addr u -- c-addr u flag )
+    2dup s" |"  compare 0= ;
+
+: ?delim   ( c-addr u -- state | c-addr u 0 )
+    ?| if 
+        2drop 1
+    else 
+        ?-- if 
+            2drop 2
+        else 
+            ?} if 2drop 3  else 0  endif
+        endif
+    endif
+;
+
+set-current
+
+: {
+    0 dup locals| locstate |
+    
+    \ stack locals until we hit a delimiter
+    begin
+        parse-word      \ ( nLocals c-addr u )
+        ?delim dup to locstate
+    0= while
+        rot 1+          \ ( c-addr u ... c-addr u nLocals )
+    repeat
+
+    \ now unstack the locals
+    0 do (local) loop   \ ( )
+
+    \ zero locals until -- or }
+    locstate 1 = if
+        begin
+            parse-word
+            ?delim dup to locstate
+        0= while
+            postpone zero  (local)
+        repeat
+    endif
+
+    0 0 (local)
+
+    \ toss words until }
+    locstate 2 = if
+        begin
+            parse-word
+            ?delim dup to locstate
+        0= while
+            2drop
+        repeat
+    endif
+
+    locstate 3 <> abort" syntax error in { } local line"
+; immediate compile-only
+
+previous 
+\ #endif
+
diff --git a/sys/boot/ficl/softwords/marker.fr b/sys/boot/ficl/softwords/marker.fr
new file mode 100644
index 0000000..c80c2cf
--- /dev/null
+++ b/sys/boot/ficl/softwords/marker.fr
@@ -0,0 +1,25 @@
+\ ** ficl/softwords/marker.fr
+\ ** Ficl implementation of CORE EXT MARKER
+\ John Sadler, 4 Oct 98
+\ Requires ficl 2.02 FORGET-WID !!
+
+: marker   ( "name" -- )
+    create  
+    get-current ,
+    get-order dup , 
+    0 ?do , loop 
+  does>
+    0 set-order                     \ clear search order
+    dup body> >name drop 
+    here - allot                    \ reset HERE to my xt-addr
+    dup @                           ( pfa current-wid )
+    dup set-current forget-wid      ( pfa )
+    cell+ dup @ swap                ( count count-addr )
+    over cells + swap               ( last-wid-addr count )
+    0 ?do 
+        dup @ dup                   ( wid-addr wid wid )
+        >search forget-wid          ( wid-addr )
+        cell- 
+    loop
+    drop
+;
diff --git a/sys/boot/ficl/softwords/oo.fr b/sys/boot/ficl/softwords/oo.fr
new file mode 100644
index 0000000..cd16c77
--- /dev/null
+++ b/sys/boot/ficl/softwords/oo.fr
@@ -0,0 +1,464 @@
+\ ** ficl/softwords/oo.fr
+\ ** F I C L   O - O   E X T E N S I O N S
+\ ** john sadler aug 1998
+
+.( loading ficl O-O extensions ) cr
+7 ficl-vocabulary oop
+also oop definitions
+
+\ Design goals:
+\ 0. Traditional OOP: late binding by default for safety. 
+\    Early binding if you ask for it.
+\ 1. Single inheritance
+\ 2. Object aggregation (has-a relationship)
+\ 3. Support objects in the dictionary and as proxies for 
+\    existing structures (by reference):
+\    *** A ficl object can wrap a C struct ***
+\ 4. Separate name-spaces for methods - methods are
+\    only visible in the context of a class / object
+\ 5. Methods can be overridden, and subclasses can add methods.
+\    No limit on number of methods.
+
+\ General info:
+\ Classes are objects, too: all classes are instances of METACLASS
+\ All classes are derived (by convention) from OBJECT. This
+\ base class provides a default initializer and superclass 
+\ access method
+
+\ A ficl object binds instance storage (payload) to a class.
+\ object  ( -- instance class )
+\ All objects push their payload address and class address when
+\ executed. All objects have this footprint:
+\ cell 0: first payload cell
+
+\ A ficl class consists of a parent class pointer, a wordlist
+\ ID for the methods of the class, and a size for the payload
+\ of objects created by the class. A class is an object.
+\ The NEW method creates and initializes an instance of a class.
+\ Classes have this footprint:
+\ cell 0: parent class address
+\ cell 1: wordlist ID
+\ cell 2: size of instance's payload
+
+\ Methods expect an object couple ( instance class ) 
+\ on the stack.
+\ Overridden methods must maintain the same stack signature as
+\ their predecessors. Ficl has no way of enforcing this, though.
+
+user current-class
+0 current-class !
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ** L A T E   B I N D I N G
+\ Compile the method name, and code to find and
+\ execute it at run-time...
+\ parse-method compiles the method name so that it pushes
+\ the string base address and count at run-time.
+\
+: parse-method  \ name  run: ( -- c-addr u )
+    parse-word
+	postpone sliteral
+; compile-only
+
+: lookup-method  ( class c-addr u -- class xt )
+	2dup
+	local u 
+	local c-addr 
+	end-locals
+	2 pick cell+ @		( -- class c-addr u wid )
+	search-wordlist 	( -- class 0 | xt 1 | xt -1 )
+	0= if
+		c-addr u type ."  not found in " 
+        body> >name type
+        cr abort 
+	endif
+;
+
+: exec-method  ( instance class c-addr u -- <method-signature> )
+    lookup-method execute
+;
+
+: find-method-xt   \ name ( class -- class xt )
+	parse-word lookup-method
+;
+
+
+\ Method lookup operator takes a class-addr and instance-addr
+\ and executes the method from the class's wordlist if
+\ interpreting. If compiling, bind late.
+\
+: -->   ( instance class -- ??? )
+    state @ 0= if
+		find-method-xt execute 
+    else  
+		parse-method  postpone exec-method
+    endif
+; immediate
+
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ** E A R L Y   B I N D I N G
+\ Early binding operator compiles code to execute a method
+\ given its class at compile time. Classes are immediate,
+\ so they leave their cell-pair on the stack when compiling.
+\ Example: 
+\   : get-wid   metaclass => .wid @ ;
+\ Usage
+\   my-class get-wid  ( -- wid-of-my-class )
+\
+: =>   \ c:( class meta -- ) run: ( -- ??? ) invokes compiled method
+	drop find-method-xt compile, drop
+; immediate compile-only
+
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ** I N S T A N C E   V A R I A B L E S
+\ Instance variables (IV) are represented by words in the class's
+\ private wordlist. Each IV word contains the offset
+\ of the IV it represents, and runs code to add that offset
+\ to the base address of an instance when executed.
+\ The metaclass SUB method, defined below, leaves the address
+\ of the new class's offset field and its initial size on the
+\ stack for these words to update. When a class definition is
+\ complete, END-CLASS saves the final size in the class's size
+\ field, and restores the search order and compile wordlist to
+\ prior state. Note that these words are hidden in their own
+\ wordlist to prevent accidental use outside a SUB END-CLASS pair.
+\
+wordlist 
+dup constant instance-vars
+dup >search ficl-set-current
+: do-instance-var
+    does>   ( instance class addr[offset] -- addr[field] )
+		nip @ +
+;
+
+: addr-units:  ( offset size "name" -- offset' )
+    create over , + 
+    do-instance-var
+;
+
+: chars:	\ ( offset nCells "name" -- offset' ) Create n char member.
+   chars addr-units: ;
+
+: char:		\ ( offset nCells "name" -- offset' ) Create 1 char member.
+   1 chars: ;
+
+: cells:  ( offset nCells "name" -- offset' )
+	cells >r aligned r> addr-units:
+;
+
+: cell:   ( offset nCells "name" -- offset' )
+    1 cells: ;
+
+\ Aggregate an object into the class...
+\ Needs the class of the instance to create
+\ Example: object obj: m_obj
+\
+: do-aggregate
+	does>   ( instance class pfa -- a-instance a-class )
+	2@          ( inst class a-class a-offset )
+	2swap drop  ( a-class a-offset inst )
+	+ swap		( a-inst a-class )
+;
+
+: obj:   ( offset class meta "name" -- offset' )
+    locals| meta class offset |
+    create  offset , class , 
+	class meta --> get-size  offset +
+	do-aggregate
+;
+
+\ Aggregate an array of objects into a class
+\ Usage example:
+\ 3 my-class array: my-array
+\ Makes an instance variable array of 3 instances of my-class
+\ named my-array.
+\
+: array:   ( offset n class meta "name" -- offset' )
+	locals| meta class nobjs offset |
+	create offset , class ,
+	class meta --> get-size  nobjs * offset + 
+	do-aggregate
+;
+
+\ Aggregate a pointer to an object: REF is a member variable
+\ whose class is set at compile time. This is useful for wrapping
+\ data structures in C, where there is only a pointer and the type
+\ it refers to is known. If you want polymorphism, see c_ref
+\ in classes.fr. REF is only useful for pre-initialized structures,
+\ since there's no supported way to set one.
+: ref:   ( offset class meta "name" -- offset' )
+	locals| meta class offset |
+	create offset , class ,
+	offset cell+
+	does>    ( inst class pfa -- ptr-inst ptr-class )
+	2@       ( inst class ptr-class ptr-offset )
+	2swap drop + @ swap
+;
+
+\ END-CLASS terminates construction of a class by storing
+\  the size of its instance variables in the class's size field
+\ ( -- old-wid addr[size] 0 )
+\
+: end-class  ( old-wid addr[size] size -- )
+    swap ! set-current 
+	search> drop		\ pop struct builder wordlist
+;
+
+set-current previous
+\ E N D   I N S T A N C E   V A R I A B L E S
+
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ D O - D O - I N S T A N C E
+\ Makes a class method that contains the code for an 
+\ instance of the class. This word gets compiled into
+\ the wordlist of every class by the SUB method.
+\ PRECONDITION: current-class contains the class address
+\
+: do-do-instance  ( -- )
+    s" : .do-instance does> [ current-class @ ] literal ;" 
+    evaluate 
+;
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ** M E T A C L A S S 
+\ Every class is an instance of metaclass. This lets
+\ classes have methods that are different from those
+\ of their instances.
+\ Classes are IMMEDIATE to make early binding simpler
+\ See above...
+\
+:noname
+	wordlist
+	create  immediate
+	0       ,	\ NULL parent class
+	dup     ,	\ wid
+	3 cells ,	\ instance size 
+	ficl-set-current
+	does> dup
+;  execute metaclass
+
+metaclass drop current-class !
+do-do-instance
+
+\
+\ C L A S S   M E T H O D S
+\
+instance-vars >search
+
+create .super  ( class metaclass -- parent-class )
+    0 cells , do-instance-var 
+
+create .wid    ( class metaclass -- wid ) \ return wid of class
+    1 cells , do-instance-var 
+
+create  .size  ( class metaclass -- size ) \ return class's payload size 
+    2 cells , do-instance-var 
+
+previous
+
+: get-size    metaclass => .size  @ ;
+: get-wid     metaclass => .wid   @ ;
+: get-super   metaclass => .super @ ;
+
+\ create an uninitialized instance of a class, leaving
+\ the address of the new instance and its class
+\
+: instance   ( class metaclass "name" -- instance class )
+    locals| meta parent |
+	create
+    here parent --> .do-instance \ ( inst class )
+    parent meta metaclass => get-size 
+    allot                        \ allocate payload space
+;
+
+\ create an uninitialized array
+: array   ( n class metaclass "name" -- n instance class ) 
+    locals| meta parent nobj |
+	create  nobj
+    here parent --> .do-instance \ ( nobj inst class )
+    parent meta metaclass => get-size
+	nobj *  allot			\ allocate payload space
+;
+
+\ create an initialized instance
+\
+: new   \ ( class metaclass "name" -- ) 
+    metaclass => instance --> init
+;
+
+\ create an initialized array of instances
+: new-array   ( n class metaclass "name" -- ) 
+	metaclass => array 
+	--> array-init
+;
+
+\ create a proxy object with initialized payload address given
+: ref   ( instance-addr class metaclass "name" -- )
+    drop create , ,
+    does> 2@ 
+;
+
+\ create a subclass
+: sub   ( class metaclass "name" -- old-wid addr[size] size )
+    wordlist
+	locals| wid meta parent |
+	parent meta metaclass => get-wid
+	wid wid-set-super
+	create  immediate  
+	here current-class !	\ prep for do-do-instance
+	parent ,	\ save parent class
+	wid    ,	\ save wid
+	here parent meta --> get-size dup ,  ( addr[size] size )
+	metaclass => .do-instance
+	wid ficl-set-current -rot
+	do-do-instance
+	instance-vars >search	\ push struct builder wordlist
+;
+
+\ OFFSET-OF returns the offset of an instance variable
+\ from the instance base address. If the next token is not
+\ the name of in instance variable method, you get garbage
+\ results -- there is no way at present to check for this error.
+: offset-of   ( class metaclass "name" -- offset )
+    drop find-method-xt nip >body @ ;
+
+\ ID returns the string name cell-pair of its class
+: id   ( class metaclass -- c-addr u )
+	drop body> >name  ;
+
+\ list methods of the class
+: methods \ ( class meta -- ) 
+	locals| meta class |
+	begin
+		class body> >name type ."  methods:" cr 
+		class meta --> get-wid >search words cr previous 
+		class meta metaclass => get-super
+		dup to class
+	0= until  cr
+;
+
+\ list class's ancestors
+: pedigree  ( class meta -- )
+	locals| meta class |
+	begin
+		class body> >name type space
+		class meta metaclass => get-super
+		dup to class
+	0= until  cr
+;
+
+\ decompile a method
+: see  ( class meta -- )   
+    metaclass => get-wid >search see previous ;
+
+set-current	
+\ E N D   M E T A C L A S S
+
+\ META is a nickname for the address of METACLASS...
+metaclass drop  
+constant meta
+
+\ SUBCLASS is a nickname for a class's SUB method...
+\ Subclass compilation ends when you invoke end-class
+\ This method is late bound for safety...
+: subclass   --> sub ;
+
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ** O B J E C T
+\ Root of all classes
+:noname
+	wordlist
+	create  immediate
+	0       ,	\ NULL parent class
+	dup     ,	\ wid
+	0       ,	\ instance size 
+	ficl-set-current
+	does> meta
+;  execute object
+
+object drop current-class ! 
+do-do-instance
+
+\ O B J E C T   M E T H O D S
+\ Convert instance cell-pair to class cell-pair
+\ Useful for binding class methods from an instance
+: class  ( instance class -- class metaclass )
+	nip meta ;
+
+\ default INIT method zero fills an instance
+: init   ( instance class -- )
+    meta 
+    metaclass => get-size   ( inst size )
+    erase ;
+
+\ Apply INIT to an array of NOBJ objects...
+\
+: array-init   ( nobj inst class -- )
+	0 dup locals| &init &next class inst |
+	\
+	\ bind methods outside the loop to save time
+	\
+	class s" init" lookup-method to &init
+	      s" next" lookup-method to &next
+	drop
+	0 ?do 
+		inst class 2dup 
+		&init execute
+		&next execute  drop to inst
+	loop
+;
+
+\ Instance aliases for common class methods
+\ Upcast to parent class
+: super     ( instance class -- instance parent-class )
+    meta  metaclass => get-super ;
+
+: pedigree  ( instance class -- )
+	object => class 
+    metaclass => pedigree ;
+
+: size      ( instance class -- sizeof-instance )
+	object => class 
+    metaclass => get-size ;
+
+: methods   ( instance class -- )
+	object => class 
+    metaclass => methods ;
+
+\ Array indexing methods...
+\ Usage examples:
+\ 10 object-array --> index
+\ obj --> next
+\
+: index   ( n instance class -- instance[n] class )
+	locals| class inst |
+	inst class 
+    object => class
+	metaclass => get-size  *   ( n*size )
+	inst +  class ;
+
+: next   ( instance[n] class -- instance[n+1] class )
+	locals| class inst |
+	inst class 
+    object => class
+	metaclass => get-size 
+	inst +
+	class ;
+
+: prev   ( instance[n] class -- instance[n-1] class )
+	locals| class inst |
+	inst class 
+    object => class
+	metaclass => get-size
+	inst swap -
+	class ;
+
+set-current
+\ E N D   O B J E C T
+
+
+previous definitions
diff --git a/sys/boot/ficl/softwords/softcore.fr b/sys/boot/ficl/softwords/softcore.fr
new file mode 100644
index 0000000..bcc2696
--- /dev/null
+++ b/sys/boot/ficl/softwords/softcore.fr
@@ -0,0 +1,125 @@
+\ ** ficl/softwords/softcore.fr
+\ ** FICL soft extensions
+\ ** John Sadler (john_sadler@alum.mit.edu)
+\ ** September, 1998
+
+\ ** Ficl USER variables
+\ ** See words.c for primitive def'n of USER
+\ #if FICL_WANT_USER
+
+variable nUser  0 nUser ! 
+: user   \ name ( -- )  
+    nUser dup @ user 1 swap +! ; 
+
+\ #endif
+
+\ ** ficl extras
+\ EMPTY cleans the parameter stack
+: empty   ( xn..x1 -- ) depth 0 ?do drop loop ;
+\ CELL- undoes CELL+
+: cell-   ( addr -- addr )  [ 1 cells ] literal -  ;
+: -rot   ( a b c -- c a b )  2 -roll ;
+
+\ ** CORE 
+: abs   ( x -- x )
+    dup 0< if negate endif ;
+decimal 32 constant bl
+
+: space   ( -- )     bl emit ;
+
+: spaces  ( n -- )   0 ?do space loop ;
+
+: abort"  
+    postpone if 
+    postpone ." 
+    postpone cr 
+    postpone abort 
+    postpone endif 
+; immediate 
+
+
+\ ** CORE EXT
+0  constant false 
+-1 constant true 
+: <>   = invert ; 
+: 0<>  0= invert ; 
+: compile,  , ; 
+: erase   ( addr u -- )    0 fill ; 
+: nip     ( y x -- x )     swap drop ; 
+: tuck    ( y x -- x y x)  swap over ; 
+
+\ ** LOCAL EXT word set
+\ #if FICL_WANT_LOCALS
+: locals|  ( name...name | -- )
+    begin
+        bl word   count
+        dup 0= abort" where's the delimiter??"
+        over c@
+        [char] | - over 1- or
+    while
+        (local)
+    repeat 2drop   0 0 (local)
+; immediate
+
+: local  ( name -- )  bl word count (local) ;  immediate
+
+: end-locals  ( -- )  0 0 (local) ;  immediate
+
+\ #endif
+
+\ ** TOOLS word set...
+: ?     ( addr -- )  @ . ;
+: dump  ( addr u -- )
+    0 ?do
+        dup c@ . 1+
+        i 7 and 7 = if cr endif
+    loop drop
+;
+
+\ ** SEARCH+EXT words and ficl helpers
+\ 
+: wordlist   ( -- )  
+    1 ficl-wordlist ;
+
+\ DO_VOCABULARY handles the DOES> part of a VOCABULARY
+\ When executed, new voc replaces top of search stack
+: do-vocabulary   ( -- ) 
+    does>  @ search> drop >search ;
+
+: vocabulary   ( name -- )  
+    wordlist create ,  do-vocabulary ; 
+
+: ficl-vocabulary   ( nBuckets name -- )  
+    ficl-wordlist create ,  do-vocabulary ; 
+
+\ ALSO dups the search stack...
+: also   ( -- )  
+    search> dup >search >search ; 
+
+\ FORTH drops the top of the search stack and pushes FORTH-WORDLIST
+: forth   ( -- )  
+    search> drop  
+    forth-wordlist >search ; 
+
+\ ONLY sets the search order to a default state
+: only   ( -- )  
+    -1 set-order ; 
+
+\ ORDER displays the compile wid and the search order list
+: order   ( -- )  
+    ." Search: " 
+    get-order  0 ?do x. loop cr 
+   ." Compile: " get-current x. cr  ; 
+
+\ PREVIOUS drops the search order stack
+: previous  ( --  )  search> drop ; 
+
+\ FICL-SET-CURRENT sets the compile wordlist and pushes the previous value
+: ficl-set-current   ( wid -- old-wid )  
+    get-current swap set-current ; 
+
+wordlist constant hidden
+: hide   hidden dup >search ficl-set-current ;
+
+\ ** E N D   S O F T C O R E . F R
+
diff --git a/sys/boot/ficl/softwords/softcore.pl b/sys/boot/ficl/softwords/softcore.pl
new file mode 100755
index 0000000..fc1e522
--- /dev/null
+++ b/sys/boot/ficl/softwords/softcore.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+# Convert forth source files to a giant C string
+
+$now = localtime;
+
+print <<EOF
+/*******************************************************************
+** s o f t c o r e . c
+** Forth Inspired Command Language - 
+** Words from CORE set written in FICL
+** Author: John Sadler (john_sadler\@alum.mit.edu)
+** Created: 27 December 1997
+** Last update: $now
+*******************************************************************/
+/*
+** This file contains definitions that are compiled into the
+** system dictionary by the first virtual machine to be created.
+** Created automagically by ficl/softwords/softcore.pl 
+*/
+
+
+#include "ficl.h"
+
+static char softWords[] = 
+EOF
+;
+
+$commenting = 0;
+
+while (<>) {
+    s"\n$"";            # remove EOL
+    s"\t"    "g;        # replace each tab with 4 spaces
+    s/\"/\\\"/g;        # escape quotes
+
+    next if /^\s*\\\s*$/;# toss empty comments
+    next if /^\s*$/;    # toss empty lines
+
+    if (/^\\\s\*\*/)  {	# emit / ** lines as C comments
+        s"^\\ "";
+        if ($commenting == 0) {
+	    print "/*\n";
+	}
+        $commenting = 1;
+        print "$_\n";
+        next;
+    }
+
+    if ($commenting == 1) {
+	print "*/\n";
+    }
+
+    $commenting = 0;
+
+    if (/^\\\s#/)  {	# pass commented preprocessor directives
+        s"^\\ "";
+        print "$_\n";
+        next;
+    }
+
+    next if /^\s*\\ /; # toss all other comments
+    s"\\\s+.*$"" ;     # lop off trailing \ comments
+    s"\s+$" ";         # remove trailing space
+    #
+    # emit all other lines as quoted string fragments
+    #
+    $out = "    \"" . $_ . " \\n\"";
+    print "$out\n";
+}
+
+if ($commenting == 1) {
+    print "*/\n";
+}
+
+print <<EOF
+    "quit ";
+
+
+void ficlCompileSoftCore(FICL_VM *pVM)
+{
+    int ret = ficlExec(pVM, softWords);
+    if (ret == VM_ERREXIT)
+        assert(FALSE);
+    return;
+}
+
+
+EOF
+;
+
diff --git a/sys/boot/ficl/stack.c b/sys/boot/ficl/stack.c
new file mode 100644
index 0000000..d06f3ce
--- /dev/null
+++ b/sys/boot/ficl/stack.c
@@ -0,0 +1,301 @@
+/*******************************************************************
+** s t a c k . c
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+** 
+*******************************************************************/
+#include <stdlib.h>
+
+#include "ficl.h"
+
+#define STKDEPTH(s) ((s)->sp - (s)->base)
+
+/*
+** N O T E: Stack convention:
+**
+** sp points to the first available cell
+** push: store value at sp, increment sp
+** pop:  decrement sp, fetch value at sp
+** Stack grows from low to high memory
+*/
+
+/*******************************************************************
+                    v m C h e c k S t a c k
+** Check the parameter stack for underflow or overflow.
+** nCells controls the type of check: if nCells is zero,
+** the function checks the stack state for underflow and overflow.
+** If nCells > 0, checks to see that the stack has room to push
+** that many cells. If less than zero, checks to see that the
+** stack has room to pop that many cells. If any test fails,
+** the function throws (via vmThrow) a VM_ERREXIT exception.
+*******************************************************************/
+void vmCheckStack(FICL_VM *pVM, int popCells, int pushCells)
+{
+    FICL_STACK *pStack = pVM->pStack;
+    int nFree = pStack->base + pStack->nCells - pStack->sp;
+
+    if (popCells > STKDEPTH(pStack))
+    {
+        vmThrowErr(pVM, "Error: stack underflow");
+    }
+
+    if (nFree < pushCells - popCells)
+    {
+        vmThrowErr(pVM, "Error: stack overflow");
+    }
+
+    return;
+}
+
+/*******************************************************************
+                    s t a c k C r e a t e
+** 
+*******************************************************************/
+
+FICL_STACK *stackCreate(unsigned nCells)
+{
+    size_t size = sizeof (FICL_STACK) + nCells * sizeof (CELL);
+    FICL_STACK *pStack = ficlMalloc(size);
+
+#if FICL_ROBUST
+    assert (nCells != 0);
+    assert (pStack != NULL);
+#endif
+
+    pStack->nCells = nCells;
+    pStack->sp     = pStack->base;
+    pStack->pFrame = NULL;
+    return pStack;
+}
+
+
+/*******************************************************************
+                    s t a c k D e l e t e
+** 
+*******************************************************************/
+
+void stackDelete(FICL_STACK *pStack)
+{
+    if (pStack)
+        ficlFree(pStack);
+    return;
+}
+
+
+/*******************************************************************
+                    s t a c k D e p t h 
+** 
+*******************************************************************/
+
+int stackDepth(FICL_STACK *pStack)
+{
+    return STKDEPTH(pStack);
+}
+
+/*******************************************************************
+                    s t a c k D r o p
+** 
+*******************************************************************/
+
+void stackDrop(FICL_STACK *pStack, int n)
+{
+#if FICL_ROBUST
+    assert(n > 0);
+#endif
+    pStack->sp -= n;
+    return;
+}
+
+
+/*******************************************************************
+                    s t a c k F e t c h
+** 
+*******************************************************************/
+
+CELL stackFetch(FICL_STACK *pStack, int n)
+{
+    return pStack->sp[-n-1];
+}
+
+void stackStore(FICL_STACK *pStack, int n, CELL c)
+{
+    pStack->sp[-n-1] = c;
+    return;
+}
+
+
+/*******************************************************************
+                    s t a c k G e t T o p
+** 
+*******************************************************************/
+
+CELL stackGetTop(FICL_STACK *pStack)
+{
+    return pStack->sp[-1];
+}
+
+
+/*******************************************************************
+                    s t a c k L i n k
+** Link a frame using the stack's frame pointer. Allot space for
+** nCells cells in the frame
+** 1) Push pFrame
+** 2) pFrame = sp
+** 3) sp += nCells
+*******************************************************************/
+
+void stackLink(FICL_STACK *pStack, int nCells)
+{
+    stackPushPtr(pStack, pStack->pFrame);
+    pStack->pFrame = pStack->sp;
+    pStack->sp += nCells;
+    return;
+}
+
+
+/*******************************************************************
+                    s t a c k U n l i n k
+** Unink a stack frame previously created by stackLink
+** 1) sp = pFrame
+** 2) pFrame = pop()
+*******************************************************************/
+
+void stackUnlink(FICL_STACK *pStack)
+{
+    pStack->sp = pStack->pFrame;
+    pStack->pFrame = stackPopPtr(pStack);
+    return;
+}
+
+
+/*******************************************************************
+                    s t a c k P i c k
+** 
+*******************************************************************/
+
+void stackPick(FICL_STACK *pStack, int n)
+{
+    stackPush(pStack, stackFetch(pStack, n));
+    return;
+}
+
+
+/*******************************************************************
+                    s t a c k P o p
+** 
+*******************************************************************/
+
+CELL stackPop(FICL_STACK *pStack)
+{
+    return *--pStack->sp;
+}
+
+void *stackPopPtr(FICL_STACK *pStack)
+{
+    return (*--pStack->sp).p;
+}
+
+UNS32 stackPopUNS32(FICL_STACK *pStack)
+{
+    return (*--pStack->sp).u;
+}
+
+INT32 stackPopINT32(FICL_STACK *pStack)
+{
+    return (*--pStack->sp).i;
+}
+
+
+/*******************************************************************
+                    s t a c k P u s h
+** 
+*******************************************************************/
+
+void stackPush(FICL_STACK *pStack, CELL c)
+{
+    *pStack->sp++ = c;
+}
+
+void stackPushPtr(FICL_STACK *pStack, void *ptr)
+{
+    *pStack->sp++ = LVALUEtoCELL(ptr);
+}
+
+void stackPushUNS32(FICL_STACK *pStack, UNS32 u)
+{
+    *pStack->sp++ = LVALUEtoCELL(u);
+}
+
+void stackPushINT32(FICL_STACK *pStack, INT32 i)
+{
+    *pStack->sp++ = LVALUEtoCELL(i);
+}
+
+/*******************************************************************
+                    s t a c k R e s e t
+** 
+*******************************************************************/
+
+void stackReset(FICL_STACK *pStack)
+{
+    pStack->sp = pStack->base;
+    return;
+}
+
+
+/*******************************************************************
+                    s t a c k R o l l 
+** Roll nth stack entry to the top (counting from zero), if n is 
+** >= 0. Drop other entries as needed to fill the hole.
+** If n < 0, roll top-of-stack to nth entry, pushing others
+** upward as needed to fill the hole.
+*******************************************************************/
+
+void stackRoll(FICL_STACK *pStack, int n)
+{
+    CELL c;
+    CELL *pCell;
+
+    if (n == 0)
+        return;
+    else if (n > 0)
+    {
+        pCell = pStack->sp - n - 1;
+        c = *pCell;
+
+        for (;n > 0; --n, pCell++)
+        {
+            *pCell = pCell[1];
+        }
+
+        *pCell = c;
+    }
+    else
+    {
+        pCell = pStack->sp - 1;
+        c = *pCell;
+
+        for (; n < 0; ++n, pCell--)
+        {
+            *pCell = pCell[-1];
+        }
+
+        *pCell = c;
+    }
+    return;
+}
+
+
+/*******************************************************************
+                    s t a c k S e t T o p
+** 
+*******************************************************************/
+
+void stackSetTop(FICL_STACK *pStack, CELL c)
+{
+    pStack->sp[-1] = c;
+    return;
+}
+
+
diff --git a/sys/boot/ficl/sysdep.c b/sys/boot/ficl/sysdep.c
new file mode 100644
index 0000000..e0164f5
--- /dev/null
+++ b/sys/boot/ficl/sysdep.c
@@ -0,0 +1,90 @@
+/*******************************************************************
+** s y s d e p . c
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+** Implementations of FICL external interface functions... 
+**
+** (simple) port to Linux, Skip Carter 26 March 1998
+**
+*******************************************************************/
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "ficl.h"
+ 
+/*
+*******************  FreeBSD  P O R T   B E G I N S   H E R E ******************** Michael Smith
+*/
+
+UNS64 ficlLongMul(UNS32 x, UNS32 y)
+{
+    UNS64 q;
+    u_int64_t qx;
+
+    qx = (u_int64_t)x * (u_int64_t) y;
+
+    q.hi = (u_int32_t)( qx >> 32 );
+    q.lo = (u_int32_t)( qx & 0xFFFFFFFFL);
+
+    return q;
+}
+
+UNSQR ficlLongDiv(UNS64 q, UNS32 y)
+{
+    UNSQR result;
+    u_int64_t qx, qh;
+
+    qh = q.hi;
+    qx = (qh << 32) | q.lo;
+
+    result.quot = qx / y;
+    result.rem  = qx % y;
+
+    return result;
+}
+
+void  ficlTextOut(FICL_VM *pVM, char *msg, int fNewline)
+{
+    IGNORE(pVM);
+
+    while(*msg != 0)
+	putchar(*(msg++));
+    if (fNewline)
+	putchar('\n');
+
+   return;
+}
+
+void *ficlMalloc (size_t size)
+{
+    return malloc(size);
+}
+
+void  ficlFree   (void *p)
+{
+    free(p);
+}
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** is guaranteed to be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** befor timeout (optional - could also block forever)
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock)
+{
+	IGNORE(fLock);
+	return 0;
+}
+#endif /* FICL_MULTITHREAD */
+
+
diff --git a/sys/boot/ficl/sysdep.h b/sys/boot/ficl/sysdep.h
new file mode 100644
index 0000000..4095701
--- /dev/null
+++ b/sys/boot/ficl/sysdep.h
@@ -0,0 +1,251 @@
+/*******************************************************************
+                    s y s d e p . h
+** Forth Inspired Command Language
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 16 Oct 1997
+** Ficl system dependent types and prototypes...
+**
+** Note: Ficl also depends on the use of "assert" when
+** FICL_ROBUST is enabled. This may require some consideration
+** in firmware systems since assert often
+** assumes stderr/stdout.  
+** 
+*******************************************************************/
+/*
+** N O T I C E -- DISCLAIMER OF WARRANTY
+** 
+** Ficl is freeware. Use it in any way that you like, with
+** the understanding that the code is not supported.
+** 
+** Any third party may reproduce, distribute, or modify the ficl
+** software code or any derivative  works thereof without any 
+** compensation or license, provided that the author information
+** and this disclaimer text are retained in the source code files.
+** The ficl software code is provided on an "as is"  basis without
+** warranty of any kind, including, without limitation, the implied
+** warranties of merchantability and fitness for a particular purpose
+** and their equivalents under the laws of any jurisdiction.  
+** 
+** I am interested in hearing from anyone who uses ficl. If you have
+** a problem, a success story, a defect, an enhancement request, or
+** if you would like to contribute to the ficl release (yay!), please
+** send me email at the address above. 
+*/
+
+#if !defined (__SYSDEP_H__)
+#define __SYSDEP_H__ 
+
+#include <sys/types.h>
+
+#include <stddef.h> /* size_t, NULL */
+#include <setjmp.h>
+
+#include <assert.h>
+
+#if !defined IGNORE		/* Macro to silence unused param warnings */
+#define IGNORE(x) &x
+#endif
+
+
+/*
+** TRUE and FALSE for C boolean operations, and
+** portable 32 bit types for CELLs
+** 
+*/
+#if !defined TRUE
+#define TRUE 1
+#endif
+#if !defined FALSE
+#define FALSE 0
+#endif
+
+
+#if !defined INT32
+#define INT32 int32_t
+#endif
+
+#if !defined UNS32
+#define UNS32 u_int32_t
+#endif
+
+#if !defined UNS16
+#define UNS16 u_int16_t
+#endif
+
+#if !defined UNS8
+#define UNS8 u_int8_t
+#endif
+
+#if !defined NULL
+#define NULL ((void *)0)
+#endif
+
+typedef struct
+{
+    UNS32 hi;
+    UNS32 lo;
+} UNS64;
+
+typedef struct
+{
+    UNS32 quot;
+    UNS32 rem;
+} UNSQR;
+
+typedef struct
+{
+    INT32 hi;
+    INT32 lo;
+} INT64;
+
+typedef struct
+{
+    INT32 quot;
+    INT32 rem;
+} INTQR;
+
+
+/*
+** Build controls
+** FICL_MULTITHREAD enables dictionary mutual exclusion
+** wia the ficlLockDictionary system dependent function.
+*/
+#if !defined FICL_MULTITHREAD
+#define FICL_MULTITHREAD 0
+#endif
+
+/*
+** FICL_ROBUST enables bounds checking of stacks and the dictionary.
+** This will detect stack over and underflows and dictionary overflows.
+** Any exceptional condition will result in an assertion failure.
+** (As generated by the ANSI assert macro)
+** FICL_ROBUST == 1 --> stack checking in the outer interpreter
+** FICL_ROBUST == 2 also enables checking in many primitives
+*/
+
+#if !defined FICL_ROBUST
+#define FICL_ROBUST 2
+#endif
+
+/*
+** FICL_DEFAULT_STACK Specifies the default size (in CELLs) of
+** a new virtual machine's stacks, unless overridden at 
+** create time.
+*/
+#if !defined FICL_DEFAULT_STACK
+#define FICL_DEFAULT_STACK 128
+#endif
+
+/*
+** FICL_DEFAULT_DICT specifies the number of CELLs to allocate
+** for the system dictionary by default. The value
+** can be overridden at startup time as well.
+** FICL_DEFAULT_ENV specifies the number of cells to allot
+** for the environment-query dictionary.
+*/
+#if !defined FICL_DEFAULT_DICT
+#define FICL_DEFAULT_DICT 12288
+#endif
+
+#if !defined FICL_DEFAULT_ENV
+#define FICL_DEFAULT_ENV 260
+#endif
+
+/*
+** FICL_DEFAULT_VOCS specifies the maximum number of wordlists in 
+** the dictionary search order. See Forth DPANS sec 16.3.3
+** (file://dpans16.htm#16.3.3)
+*/
+#if !defined FICL_DEFAULT_VOCS
+#define FICL_DEFAULT_VOCS 16
+#endif
+
+/*
+** User variables: per-instance variables bound to the VM.
+** Kinda like thread-local storage. Could be implemented in a 
+** VM private dictionary, but I've chosen the lower overhead
+** approach of an array of CELLs instead.
+*/
+#if !defined FICL_WANT_USER
+#define FICL_WANT_USER 1
+#endif
+
+#if !defined FICL_USER_CELLS
+#define FICL_USER_CELLS 16
+#endif
+
+/* 
+** FICL_WANT_LOCALS controls the creation of the LOCALS wordset and
+** a private dictionary for local variable compilation.
+*/
+#if !defined FICL_WANT_LOCALS
+#define FICL_WANT_LOCALS 1
+#endif
+
+/* Max number of local variables per definition */
+#if !defined FICL_MAX_LOCALS
+#define FICL_MAX_LOCALS 16
+#endif
+
+/*
+** FICL_ALIGN is the power of two to which the dictionary
+** pointer address must be aligned. This value is usually
+** either 1 or 2, depending on the memory architecture
+** of the target system; 2 is safe on any 16 or 32 bit
+** machine.
+*/
+#if !defined FICL_ALIGN
+#define FICL_ALIGN 2
+#define FICL_ALIGN_ADD ((1 << FICL_ALIGN) - 1)
+#endif
+
+/*
+** System dependent routines --
+** edit the implementations in sysdep.c to be compatible
+** with your runtime environment...
+** ficlTextOut sends a NULL terminated string to the 
+**   default output device - used for system error messages
+** ficlMalloc and ficlFree have the same semantics as malloc and free
+**   in standard C
+** ficlLongMul multiplies two UNS32s and returns a 64 bit unsigned 
+**   product
+** ficlLongDiv divides an UNS64 by an UNS32 and returns UNS32 quotient
+**   and remainder
+*/
+struct vm;
+void  ficlTextOut(struct vm *pVM, char *msg, int fNewline);
+void *ficlMalloc (size_t size);
+void  ficlFree   (void *p);
+
+/*
+** Stub function for dictionary access control - does nothing
+** by default, user can redefine to guarantee exclusive dict
+** access to a single thread for updates. All dict update code
+** must be bracketed as follows:
+** ficlLockDictionary(TRUE);
+** <code that updates dictionary>
+** ficlLockDictionary(FALSE);
+**
+** Returns zero if successful, nonzero if unable to acquire lock
+** before timeout (optional - could also block forever)
+**
+** NOTE: this function must be implemented with lock counting
+** semantics: nested calls must behave properly.
+*/
+#if FICL_MULTITHREAD
+int ficlLockDictionary(short fLock);
+#else
+#define ficlLockDictionary(x) 0 /* ignore */
+#endif
+
+/*
+** 64 bit integer math support routines: multiply two UNS32s
+** to get a 64 bit prodict, & divide the product by an UNS32
+** to get an UNS32 quotient and remainder. Much easier in asm
+** on a 32 bit CPU than in C, which usually doesn't support 
+** the double length result (but it should).
+*/
+UNS64 ficlLongMul(UNS32 x, UNS32 y);
+UNSQR ficlLongDiv(UNS64 q, UNS32 y);
+
+#endif /*__SYSDEP_H__*/
diff --git a/sys/boot/ficl/testmain.c b/sys/boot/ficl/testmain.c
new file mode 100644
index 0000000..3e70195
--- /dev/null
+++ b/sys/boot/ficl/testmain.c
@@ -0,0 +1,299 @@
+/*
+** stub main for testing FICL under Win32
+** 
+*/
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#ifdef WIN32
+#include <direct.h>
+#endif
+#include <sys/types.h>
+#include <sys/stat.h>
+#ifdef linux
+#include <unistd.h>
+#endif
+
+#include "ficl.h"
+
+/*
+** Ficl interface to _getcwd (Win32)
+** Prints the current working directory using the VM's 
+** textOut method...
+*/
+static void ficlGetCWD(FICL_VM *pVM)
+{
+    char *cp;
+
+#ifdef WIN32   
+    cp = _getcwd(NULL, 80);
+#else
+   cp = getcwd(NULL, 80);
+#endif
+    vmTextOut(pVM, cp, 1);
+    free(cp);
+    return;
+}
+
+/*
+** Ficl interface to _chdir (Win32)
+** Gets a newline (or NULL) delimited string from the input
+** and feeds it to the Win32 chdir function...
+** Example:
+**    cd c:\tmp
+*/
+static void ficlChDir(FICL_VM *pVM)
+{
+    FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
+    vmGetString(pVM, pFS, '\n');
+    if (pFS->count > 0)
+    {
+#ifdef WIN32
+       int err = _chdir(pFS->text);
+#else
+       int err = chdir(pFS->text);
+#endif
+       if (err)
+        {
+            vmTextOut(pVM, "Error: path not found", 1);
+            vmThrow(pVM, VM_QUIT);
+        }
+    }
+    else
+    {
+        vmTextOut(pVM, "Warning (chdir): nothing happened", 1);
+    }
+    return;
+}
+
+/*
+** Ficl interface to system (ANSI)
+** Gets a newline (or NULL) delimited string from the input
+** and feeds it to the Win32 system function...
+** Example:
+**    system del *.*
+**    \ ouch!
+*/
+static void ficlSystem(FICL_VM *pVM)
+{
+    FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
+
+    vmGetString(pVM, pFS, '\n');
+    if (pFS->count > 0)
+    {
+        int err = system(pFS->text);
+        if (err)
+        {
+            sprintf(pVM->pad, "System call returned %d", err);
+            vmTextOut(pVM, pVM->pad, 1);
+            vmThrow(pVM, VM_QUIT);
+        }
+    }
+    else
+    {
+        vmTextOut(pVM, "Warning (system): nothing happened", 1);
+    }
+    return;
+}
+
+/*
+** Ficl add-in to load a text file and execute it...
+** Cheesy, but illustrative.
+** Line oriented... filename is newline (or NULL) delimited.
+** Example:
+**    load test.ficl
+*/
+#define nLINEBUF 256
+static void ficlLoad(FICL_VM *pVM)
+{
+    char    cp[nLINEBUF];
+    char    filename[nLINEBUF];
+    FICL_STRING *pFilename = (FICL_STRING *)filename;
+    int     nLine = 0;
+    FILE   *fp;
+    int     result;
+    CELL    id;
+#ifdef WIN32       
+    struct _stat buf;
+#else
+    struct stat buf;
+#endif
+
+
+    vmGetString(pVM, pFilename, '\n');
+
+    if (pFilename->count <= 0)
+    {
+        vmTextOut(pVM, "Warning (load): nothing happened", 1);
+        return;
+    }
+
+    /*
+    ** get the file's size and make sure it exists 
+    */
+#ifdef WIN32       
+    result = _stat( pFilename->text, &buf );
+#else
+    result = stat( pFilename->text, &buf );
+#endif
+
+    if (result != 0)
+    {
+        vmTextOut(pVM, "Unable to stat file: ", 0);
+        vmTextOut(pVM, pFilename->text, 1);
+        vmThrow(pVM, VM_QUIT);
+    }
+
+    fp = fopen(pFilename->text, "r");
+    if (!fp)
+    {
+        vmTextOut(pVM, "Unable to open file ", 0);
+        vmTextOut(pVM, pFilename->text, 1);
+        vmThrow(pVM, VM_QUIT);
+    }
+
+    id = pVM->sourceID;
+    pVM->sourceID.p = (void *)fp;
+
+    /* feed each line to ficlExec */
+    while (fgets(cp, nLINEBUF, fp))
+    {
+        int len = strlen(cp) - 1;
+
+        nLine++;
+        if (len <= 0)
+            continue;
+
+        if (cp[len] == '\n')
+            cp[len] = '\0';
+
+        result = ficlExec(pVM, cp);
+        if (result >= VM_ERREXIT)
+        {
+            pVM->sourceID = id;
+            fclose(fp);
+            vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);
+            break; 
+        }
+    }
+    /*
+    ** Pass an empty line with SOURCE-ID == 0 to flush
+    ** any pending REFILLs (as required by FILE wordset)
+    */
+    pVM->sourceID.i = -1;
+    ficlExec(pVM, "");
+
+    pVM->sourceID = id;
+    fclose(fp);
+
+    return;
+}
+
+/*
+** Dump a tab delimited file that summarizes the contents of the
+** dictionary hash table by hashcode...
+*/
+static void spewHash(FICL_VM *pVM)
+{
+    FICL_HASH *pHash = ficlGetDict()->pForthWords;
+    FICL_WORD *pFW;
+    FILE *pOut;
+    unsigned i;
+    unsigned nHash = pHash->size;
+
+    if (!vmGetWordToPad(pVM))
+        vmThrow(pVM, VM_OUTOFTEXT);
+
+    pOut = fopen(pVM->pad, "w");
+    if (!pOut)
+    {
+        vmTextOut(pVM, "unable to open file", 1);
+        return;
+    }
+
+    for (i=0; i < nHash; i++)
+    {
+        int n = 0;
+
+        pFW = pHash->table[i];
+        while (pFW)
+        {
+            n++;
+            pFW = pFW->link;
+        }
+
+        fprintf(pOut, "%d\t%d", i, n);
+
+        pFW = pHash->table[i];
+        while (pFW)
+        {
+            fprintf(pOut, "\t%s", pFW->name);
+            pFW = pFW->link;
+        }
+
+        fprintf(pOut, "\n");
+    }
+
+    fclose(pOut);
+    return;
+}
+
+static void ficlBreak(FICL_VM *pVM)
+{
+    pVM->state = pVM->state;
+    return;
+}
+
+void buildTestInterface(void)
+{
+    ficlBuild("break",    ficlBreak,    FW_DEFAULT);
+    ficlBuild("cd",       ficlChDir,    FW_DEFAULT);
+    ficlBuild("load",     ficlLoad,     FW_DEFAULT);
+    ficlBuild("pwd",      ficlGetCWD,   FW_DEFAULT);
+    ficlBuild("system",   ficlSystem,   FW_DEFAULT);
+    ficlBuild("spewhash", spewHash,     FW_DEFAULT);
+
+    return;
+}
+
+
+#if !defined (_WINDOWS)
+
+int main(int argc, char **argv)
+{
+    char in[256];
+    FICL_VM *pVM;
+
+    ficlInitSystem(10000);
+    buildTestInterface();
+    pVM = ficlNewVM();
+
+    ficlExec(pVM, ".ver .( " __DATE__ " ) cr quit");
+
+    /*
+    ** load file from cmd line...
+    */
+    if (argc  > 1)
+    {
+        sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
+        ficlExec(pVM, in);
+    }
+
+    for (;;)
+    {
+        int ret;
+        gets(in);
+        ret = ficlExec(pVM, in);
+        if (ret == VM_USEREXIT)
+        {
+            ficlTermSystem();
+            break;
+        }
+    }
+
+    return 0;
+}
+
+#endif
+
diff --git a/sys/boot/ficl/vm.c b/sys/boot/ficl/vm.c
new file mode 100644
index 0000000..ebbe1c0
--- /dev/null
+++ b/sys/boot/ficl/vm.c
@@ -0,0 +1,561 @@
+/*******************************************************************

+** v m . c
+** Forth Inspired Command Language - virtual machine methods
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 19 July 1997
+** 
+*******************************************************************/
+/*
+** This file implements the virtual machine of FICL. Each virtual
+** machine retains the state of an interpreter. A virtual machine
+** owns a pair of stacks for parameters and return addresses, as
+** well as a pile of state variables and the two dedicated registers
+** of the interp.
+*/
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
+#include <ctype.h>
+#include "ficl.h"
+
+static char digits[] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+
+/**************************************************************************
+                        v m B r a n c h R e l a t i v e 
+** 
+**************************************************************************/
+void vmBranchRelative(FICL_VM *pVM, int offset)
+{
+    pVM->ip += offset;
+    return;
+}
+
+
+/**************************************************************************
+                        v m C r e a t e
+** 
+**************************************************************************/
+FICL_VM *vmCreate(FICL_VM *pVM, unsigned nPStack, unsigned nRStack)
+{
+    if (pVM == NULL)
+    {
+        pVM = (FICL_VM *)ficlMalloc(sizeof (FICL_VM));
+        pVM->pStack = NULL;
+        pVM->rStack = NULL;
+        pVM->link   = NULL;
+    }
+    assert (pVM);
+
+    if (pVM->pStack)
+        stackDelete(pVM->pStack);
+    pVM->pStack = stackCreate(nPStack);
+
+    if (pVM->rStack)
+        stackDelete(pVM->rStack);
+    pVM->rStack = stackCreate(nRStack);
+
+    pVM->textOut = ficlTextOut;
+
+    vmReset(pVM);
+    return pVM;
+}
+
+
+/**************************************************************************
+                        v m D e l e t e
+** 
+**************************************************************************/
+void vmDelete (FICL_VM *pVM)
+{
+    if (pVM)
+    {
+        ficlFree(pVM->pStack);
+        ficlFree(pVM->rStack);
+        ficlFree(pVM);
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        v m E x e c u t e
+** 
+**************************************************************************/
+void vmExecute(FICL_VM *pVM, FICL_WORD *pWord)
+{
+    pVM->runningWord = pWord;
+    pWord->code(pVM);
+    return;
+}
+
+
+/**************************************************************************
+                        v m G e t S t r i n g
+** Parses a string out of the VM input buffer and copies up to the first
+** FICL_STRING_MAX characters to the supplied destination buffer, a
+** FICL_STRING. The destination string is NULL terminated.
+** 
+** Returns the address of the first unused character in the dest buffer.
+**************************************************************************/
+char *vmGetString(FICL_VM *pVM, FICL_STRING *spDest, char delimiter)
+{
+    STRINGINFO si = vmParseString(pVM, delimiter);
+
+    if (SI_COUNT(si) > FICL_STRING_MAX)
+    {
+        SI_SETLEN(si, FICL_STRING_MAX);
+    }
+
+    strncpy(spDest->text, SI_PTR(si), SI_COUNT(si));
+    spDest->text[SI_COUNT(si)] = '\0';
+    spDest->count = (FICL_COUNT)SI_COUNT(si);
+
+    return spDest->text + SI_COUNT(si) + 1;
+}
+
+
+/**************************************************************************
+                        v m G e t W o r d
+** vmGetWord calls vmGetWord0 repeatedly until it gets a string with 
+** non-zero length.
+**************************************************************************/
+STRINGINFO vmGetWord(FICL_VM *pVM)
+{
+    STRINGINFO si = vmGetWord0(pVM);
+
+    if (SI_COUNT(si) == 0)
+    {
+        vmThrow(pVM, VM_RESTART);
+    }
+
+    return si;
+}
+
+
+/**************************************************************************
+                        v m G e t W o r d 0
+** Skip leading whitespace and parse a space delimited word from the tib.
+** Returns the start address and length of the word. Updates the tib
+** to reflect characters consumed, including the trailing delimiter.
+** If there's nothing of interest in the tib, returns zero. This function
+** does not use vmParseString because it uses isspace() rather than a
+** single  delimiter character.
+**************************************************************************/
+STRINGINFO vmGetWord0(FICL_VM *pVM)
+{
+    char *pSrc  = vmGetInBuf(pVM);
+    STRINGINFO si;
+    UNS32 count = 0;
+    char ch;
+
+    pSrc = skipSpace(pSrc);
+    SI_SETPTR(si, pSrc);
+
+    for (ch = *pSrc; ch != '\0' && !isspace(ch); ch = *++pSrc)
+    {
+        count++;
+    }
+
+    SI_SETLEN(si, count);
+
+    if (isspace(ch))    /* skip one trailing delimiter */
+        pSrc++;
+
+    vmUpdateTib(pVM, pSrc);
+
+    return si;
+}
+
+
+/**************************************************************************
+                        v m G e t W o r d T o P a d
+** Does vmGetWord0 and copies the result to the pad as a NULL terminated
+** string. Returns the length of the string. If the string is too long 
+** to fit in the pad, it is truncated.
+**************************************************************************/
+int vmGetWordToPad(FICL_VM *pVM)
+{
+    STRINGINFO si;
+    char *cp = (char *)pVM->pad;
+    si = vmGetWord0(pVM);
+
+    if (SI_COUNT(si) > nPAD)
+        SI_SETLEN(si, nPAD);
+
+    strncpy(cp, SI_PTR(si), SI_COUNT(si));
+    cp[SI_COUNT(si)] = '\0';
+    return (int)(SI_COUNT(si));
+}
+
+
+/**************************************************************************
+                        v m P a r s e S t r i n g
+** Parses a string out of the input buffer using the delimiter
+** specified. Skips leading delimiters, marks the start of the string,
+** and counts characters to the next delimiter it encounters. It then 
+** updates the vm input buffer to consume all these chars, including the
+** trailing delimiter. 
+** Returns the address and length of the parsed string, not including the
+** trailing delimiter.
+**************************************************************************/
+STRINGINFO vmParseString(FICL_VM *pVM, char delim)
+{
+    STRINGINFO si;
+    char *pSrc      = vmGetInBuf(pVM);
+    char ch;
+
+    while (*pSrc == delim)  /* skip lead delimiters */
+        pSrc++;
+
+    SI_SETPTR(si, pSrc);    /* mark start of text */
+
+    for (ch = *pSrc; (ch != delim)
+                  && (ch != '\0') 
+                  && (ch != '\r') 
+                  && (ch != '\n'); ch = *++pSrc)
+    {
+        ;                   /* find next delimiter or end of line */
+    }
+
+                            /* set length of result */
+    SI_SETLEN(si, pSrc - SI_PTR(si));
+
+    if (*pSrc == delim)     /* gobble trailing delimiter */
+        pSrc++;
+
+    vmUpdateTib(pVM, pSrc);
+    return si;
+}
+
+
+/**************************************************************************
+                        v m P o p I P
+** 
+**************************************************************************/
+void vmPopIP(FICL_VM *pVM)
+{
+    pVM->ip = (IPTYPE)(stackPopPtr(pVM->rStack));
+    return;
+}
+
+
+/**************************************************************************
+                        v m P u s h I P
+** 
+**************************************************************************/
+void vmPushIP(FICL_VM *pVM, IPTYPE newIP)
+{
+    stackPushPtr(pVM->rStack, (void *)pVM->ip);
+    pVM->ip = newIP;
+    return;
+}
+
+
+/**************************************************************************
+                        v m P u s h T i b
+** Binds the specified input string to the VM and clears >IN (the index)
+**************************************************************************/
+void vmPushTib(FICL_VM *pVM, char *text, TIB *pSaveTib)
+{
+    if (pSaveTib)
+    {
+        *pSaveTib = pVM->tib;
+    }
+
+    pVM->tib.cp = text;
+    pVM->tib.index = 0;
+}
+
+
+void vmPopTib(FICL_VM *pVM, TIB *pTib)
+{
+    if (pTib)
+    {
+        pVM->tib = *pTib;
+    }
+    return;
+}
+
+
+/**************************************************************************
+                        v m Q u i t
+** 
+**************************************************************************/
+void vmQuit(FICL_VM *pVM)
+{
+    static FICL_WORD *pInterp = NULL;
+    if (!pInterp)
+        pInterp = ficlLookup("interpret");
+    assert(pInterp);
+
+    stackReset(pVM->rStack);
+    pVM->fRestart    = 0;
+    pVM->ip          = &pInterp;
+    pVM->runningWord = pInterp;
+    pVM->state       = INTERPRET;
+    pVM->tib.cp      = NULL;
+    pVM->tib.index   = 0;
+    pVM->pad[0]      = '\0';
+    pVM->sourceID.i  = 0;
+    return;
+}
+
+
+/**************************************************************************
+                        v m R e s e t 
+** 
+**************************************************************************/
+void vmReset(FICL_VM *pVM)
+{
+    vmQuit(pVM);
+    stackReset(pVM->pStack);
+    pVM->base        = 10;
+    return;
+}
+
+
+/**************************************************************************
+                        v m S e t T e x t O u t
+** Binds the specified output callback to the vm. If you pass NULL,
+** binds the default output function (ficlTextOut)
+**************************************************************************/
+void vmSetTextOut(FICL_VM *pVM, OUTFUNC textOut)
+{
+    if (textOut)
+        pVM->textOut = textOut;
+    else
+        pVM->textOut = ficlTextOut;
+
+    return;
+}
+
+
+/**************************************************************************
+                        v m T e x t O u t
+** Feeds text to the vm's output callback
+**************************************************************************/
+void vmTextOut(FICL_VM *pVM, char *text, int fNewline)
+{
+    assert(pVM);
+    assert(pVM->textOut);
+    (pVM->textOut)(pVM, text, fNewline);
+
+    return;
+}
+
+
+/**************************************************************************
+                        v m T h r o w
+** 
+**************************************************************************/
+void vmThrow(FICL_VM *pVM, int except)
+{
+    longjmp(*(pVM->pState), except);
+}
+
+
+void vmThrowErr(FICL_VM *pVM, char *fmt, ...)
+{
+    va_list va;
+    va_start(va, fmt);
+    vsprintf(pVM->pad, fmt, va);
+    vmTextOut(pVM, pVM->pad, 1);
+    va_end(va);
+    longjmp(*(pVM->pState), VM_ERREXIT);
+}
+
+
+/**************************************************************************
+                        w o r d I s I m m e d i a t e
+** 
+**************************************************************************/
+int wordIsImmediate(FICL_WORD *pFW)
+{
+    return ((pFW != NULL) && (pFW->flags & FW_IMMEDIATE));
+}
+
+
+/**************************************************************************
+                        w o r d I s C o m p i l e O n l y
+** 
+**************************************************************************/
+int wordIsCompileOnly(FICL_WORD *pFW)
+{
+    return ((pFW != NULL) && (pFW->flags & FW_COMPILE));
+}
+
+
+/**************************************************************************
+                        s t r r e v
+** 
+**************************************************************************/
+char *strrev( char *string )    
+{                               /* reverse a string in-place */
+    int i = strlen(string);
+    char *p1 = string;          /* first char of string */
+    char *p2 = string + i - 1;  /* last non-NULL char of string */
+    char c;
+
+    if (i > 1)
+    {
+        while (p1 < p2)
+        {
+            c = *p2;
+            *p2 = *p1;
+            *p1 = c;
+            p1++; p2--;
+        }
+    }
+        
+    return string;
+}
+
+
+/**************************************************************************
+                        d i g i t _ t o _ c h a r
+** 
+**************************************************************************/
+char digit_to_char(int value)
+{
+    return digits[value];
+}
+
+
+/**************************************************************************
+                        l t o a
+** 
+**************************************************************************/
+char *ltoa( INT32 value, char *string, int radix )
+{                               /* convert long to string, any base */
+    char *cp = string;
+    int sign = ((radix == 10) && (value < 0));
+    UNSQR result;
+    UNS64 v;
+
+    assert(radix > 1);
+    assert(radix < 37);
+    assert(string);
+
+    if (sign)
+        value = -value;
+
+    if (value == 0)
+        *cp++ = '0';
+    else
+    {
+        v.hi = 0;
+        v.lo = (UNS32)value;
+        while (v.lo)
+        {
+            result = ficlLongDiv(v, (UNS32)radix);
+            *cp++ = digits[result.rem];
+            v.lo = result.quot;
+        }
+    }
+
+    if (sign)
+        *cp++ = '-';
+
+    *cp++ = '\0';
+
+    return strrev(string);
+}
+
+
+/**************************************************************************
+                        u l t o a
+** 
+**************************************************************************/
+char *ultoa(UNS32 value, char *string, int radix )
+{                               /* convert long to string, any base */
+    char *cp = string;
+    UNS64 ud;
+    UNSQR result;
+
+    assert(radix > 1);
+    assert(radix < 37);
+    assert(string);
+
+    if (value == 0)
+        *cp++ = '0';
+    else
+    {
+        ud.hi = 0;
+        ud.lo = value;
+        result.quot = value;
+
+        while (ud.lo)
+        {
+            result = ficlLongDiv(ud, (UNS32)radix);
+            ud.lo = result.quot;
+            *cp++ = digits[result.rem];
+        }
+    }
+
+    *cp++ = '\0';
+
+    return strrev(string);
+}
+
+
+/**************************************************************************
+                        c a s e F o l d
+** Case folds a NULL terminated string in place. All characters
+** get converted to lower case.
+**************************************************************************/
+char *caseFold(char *cp)
+{
+    char *oldCp = cp;
+
+    while (*cp)
+    {
+        if (isupper(*cp))
+            *cp = (char)tolower(*cp);
+        cp++;
+    }
+
+    return oldCp;
+}
+
+
+/**************************************************************************
+                        s t r i n c m p
+** 
+**************************************************************************/
+int strincmp(char *cp1, char *cp2, FICL_COUNT count)
+{
+    int i = 0;
+    char c1, c2;
+
+    for (c1 = *cp1, c2 = *cp2;
+        ((i == 0) && count && c1 && c2);
+        c1 = *++cp1, c2 = *++cp2, count--)
+    {
+        i = tolower(c1) - tolower(c2);
+    }
+
+    return i;
+}
+
+
+
+/**************************************************************************
+                        s k i p S p a c e
+** Given a string pointer, returns a pointer to the first non-space
+** char of the string, or to the NULL terminator if no such char found.
+**************************************************************************/
+char *skipSpace(char *cp)
+{
+    assert(cp);
+
+    while (isspace(*cp))
+        cp++;
+
+    return cp;
+}
+
+
diff --git a/sys/boot/ficl/words.c b/sys/boot/ficl/words.c
new file mode 100644
index 0000000..dce6507
--- /dev/null
+++ b/sys/boot/ficl/words.c
@@ -0,0 +1,4339 @@
+/*******************************************************************
+** w o r d s . c
+** Forth Inspired Command Language
+** ANS Forth CORE word-set written in C
+** Author: John Sadler (john_sadler@alum.mit.edu)
+** Created: 19 July 1997
+** 
+*******************************************************************/
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include "ficl.h"
+#include "math64.h"
+
+static void colonParen(FICL_VM *pVM);
+static void literalIm(FICL_VM *pVM);
+static void interpWord(FICL_VM *pVM, STRINGINFO si);
+
+/*
+** Control structure building words use these
+** strings' addresses as markers on the stack to 
+** check for structure completion.
+*/
+static char doTag[]    = "do";
+static char ifTag[]    = "if";
+static char colonTag[] = "colon";
+static char leaveTag[] = "leave";
+static char beginTag[] = "begin";
+static char whileTag[] = "while";
+
+/*
+** Pointers to various words in the dictionary
+** -- initialized by ficlCompileCore, below --
+** for use by compiling words. Colon definitions
+** in ficl are lists of pointers to words. A bit
+** simple-minded...
+*/
+static FICL_WORD *pBranchParen  = NULL;
+static FICL_WORD *pComma        = NULL;
+static FICL_WORD *pDoParen      = NULL;
+static FICL_WORD *pDoesParen    = NULL;
+static FICL_WORD *pExitParen    = NULL;
+static FICL_WORD *pIfParen      = NULL;
+static FICL_WORD *pInterpret    = NULL;
+static FICL_WORD *pLitParen     = NULL;
+static FICL_WORD *pLoopParen    = NULL;
+static FICL_WORD *pPLoopParen   = NULL;
+static FICL_WORD *pQDoParen     = NULL;
+static FICL_WORD *pSemiParen    = NULL;
+static FICL_WORD *pStore        = NULL;
+static FICL_WORD *pStringLit    = NULL;
+static FICL_WORD *pType         = NULL;
+
+#if FICL_WANT_LOCALS
+static FICL_WORD *pGetLocalParen= NULL;
+static FICL_WORD *pGetLocal0    = NULL;
+static FICL_WORD *pGetLocal1    = NULL;
+static FICL_WORD *pToLocalParen = NULL;
+static FICL_WORD *pToLocal0     = NULL;
+static FICL_WORD *pToLocal1     = NULL;
+static FICL_WORD *pLinkParen    = NULL;
+static FICL_WORD *pUnLinkParen  = NULL;
+static int nLocals = 0;
+#endif
+
+
+/*
+** C O N T R O L   S T R U C T U R E   B U I L D E R S
+**
+** Push current dict location for later branch resolution.
+** The location may be either a branch target or a patch address...
+*/
+static void markBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
+{
+    stackPushPtr(pVM->pStack, dp->here);
+    stackPushPtr(pVM->pStack, tag);
+    return;
+}
+
+static void markControlTag(FICL_VM *pVM, char *tag)
+{
+    stackPushPtr(pVM->pStack, tag);
+    return;
+}
+
+static void matchControlTag(FICL_VM *pVM, char *tag)
+{
+    char *cp = (char *)stackPopPtr(pVM->pStack);
+    if ( strcmp(cp, tag) )
+    {
+        vmTextOut(pVM, "Warning -- unmatched control word: ", 0);
+        vmTextOut(pVM, tag, 1);
+    }
+
+    return;
+}
+
+/*
+** Expect a branch target address on the param stack,
+** compile a literal offset from the current dict location
+** to the target address
+*/
+static void resolveBackBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
+{
+    long offset;
+    CELL *patchAddr;
+
+    matchControlTag(pVM, tag);
+
+    patchAddr = (CELL *)stackPopPtr(pVM->pStack);
+    offset = patchAddr - dp->here;
+    dictAppendCell(dp, LVALUEtoCELL(offset));
+
+    return;
+}
+
+
+/*
+** Expect a branch patch address on the param stack,
+** compile a literal offset from the patch location
+** to the current dict location
+*/
+static void resolveForwardBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
+{
+    long offset;
+    CELL *patchAddr;
+
+    matchControlTag(pVM, tag);
+
+    patchAddr = (CELL *)stackPopPtr(pVM->pStack);
+    offset = dp->here - patchAddr;
+    *patchAddr = LVALUEtoCELL(offset);
+
+    return;
+}
+
+/*
+** Match the tag to the top of the stack. If success,
+** sopy "here" address into the cell whose address is next
+** on the stack. Used by do..leave..loop.
+*/
+static void resolveAbsBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
+{
+    CELL *patchAddr;
+    char *cp;
+
+    cp = stackPopPtr(pVM->pStack);
+    if (strcmp(cp, tag))
+    {
+        vmTextOut(pVM, "Warning -- Unmatched control word: ", 0);
+        vmTextOut(pVM, tag, 1);
+    }
+
+    patchAddr = (CELL *)stackPopPtr(pVM->pStack);
+    *patchAddr = LVALUEtoCELL(dp->here);
+
+    return;
+}
+
+
+/**************************************************************************
+                        i s N u m b e r
+** Attempts to convert the NULL terminated string in the VM's pad to 
+** a number using the VM's current base. If successful, pushes the number
+** onto the param stack and returns TRUE. Otherwise, returns FALSE.
+**************************************************************************/
+
+static int isNumber(FICL_VM *pVM, STRINGINFO si)
+{
+    INT32 accum     = 0;
+    char isNeg      = FALSE;
+    unsigned base   = pVM->base;
+    char *cp        = SI_PTR(si);
+    FICL_COUNT count= (FICL_COUNT)SI_COUNT(si);
+    unsigned ch;
+    unsigned digit;
+
+    if (*cp == '-')
+    {
+        cp++;
+        count--;
+        isNeg = TRUE;
+    }
+    else if ((cp[0] == '0') && (cp[1] == 'x'))
+    {               /* detect 0xNNNN format for hex numbers */
+        cp += 2;
+        count -= 2;
+        base = 16;
+    }
+
+    if (count == 0)
+        return FALSE;
+
+    while (count-- && ((ch = *cp++) != '\0'))
+    {
+        if (ch < '0')
+            return FALSE;
+
+        digit = ch - '0';
+
+        if (digit > 9)
+            digit = tolower(ch) - 'a' + 10;
+        /* 
+        ** Note: following test also catches chars between 9 and a
+        ** because 'digit' is unsigned!
+        */
+        if (digit >= base)
+            return FALSE;
+
+        accum = accum * base + digit;
+    }
+
+    if (isNeg)
+		accum = -accum;
+
+    stackPushINT32(pVM->pStack, accum);
+
+    return TRUE;
+}
+
+
+/**************************************************************************
+                        a d d   &   f r i e n d s
+** 
+**************************************************************************/
+
+static void add(FICL_VM *pVM)
+{
+    INT32 i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    i = stackPopINT32(pVM->pStack);
+    i += stackGetTop(pVM->pStack).i;
+    stackSetTop(pVM->pStack, LVALUEtoCELL(i));
+    return;
+}
+
+static void sub(FICL_VM *pVM)
+{
+    INT32 i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    i = stackPopINT32(pVM->pStack);
+    i = stackGetTop(pVM->pStack).i - i;
+    stackSetTop(pVM->pStack, LVALUEtoCELL(i));
+    return;
+}
+
+static void mul(FICL_VM *pVM)
+{
+    INT32 i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    i = stackPopINT32(pVM->pStack);
+    i *= stackGetTop(pVM->pStack).i;
+    stackSetTop(pVM->pStack, LVALUEtoCELL(i));
+    return;
+}
+
+static void negate(FICL_VM *pVM)
+{
+    INT32 i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    i = -stackPopINT32(pVM->pStack);
+    stackPushINT32(pVM->pStack, i);
+    return;
+}
+
+static void ficlDiv(FICL_VM *pVM)
+{
+    INT32 i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    i = stackPopINT32(pVM->pStack);
+    i = stackGetTop(pVM->pStack).i / i;
+    stackSetTop(pVM->pStack, LVALUEtoCELL(i));
+    return;
+}
+
+/*
+** slash-mod        CORE ( n1 n2 -- n3 n4 )
+** Divide n1 by n2, giving the single-cell remainder n3 and the single-cell
+** quotient n4. An ambiguous condition exists if n2 is zero. If n1 and n2
+** differ in sign, the implementation-defined result returned will be the
+** same as that returned by either the phrase
+** >R S>D R> FM/MOD or the phrase >R S>D R> SM/REM . 
+** NOTE: Ficl complies with the second phrase (symmetric division)
+*/
+static void slashMod(FICL_VM *pVM)
+{
+    INT64 n1;
+    INT32 n2;
+    INTQR qr;
+
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 2);
+#endif
+    n2    = stackPopINT32(pVM->pStack);
+    n1.lo = stackPopINT32(pVM->pStack);
+    i64Extend(n1);
+
+    qr = m64SymmetricDivI(n1, n2);
+    stackPushINT32(pVM->pStack, qr.rem);
+    stackPushINT32(pVM->pStack, qr.quot);
+    return;
+}
+
+static void onePlus(FICL_VM *pVM)
+{
+    INT32 i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    i = stackGetTop(pVM->pStack).i;
+    i += 1;
+    stackSetTop(pVM->pStack, LVALUEtoCELL(i));
+    return;
+}
+
+static void oneMinus(FICL_VM *pVM)
+{
+    INT32 i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    i = stackGetTop(pVM->pStack).i;
+    i -= 1;
+    stackSetTop(pVM->pStack, LVALUEtoCELL(i));
+    return;
+}
+
+static void twoMul(FICL_VM *pVM)
+{
+    INT32 i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    i = stackGetTop(pVM->pStack).i;
+    i *= 2;
+    stackSetTop(pVM->pStack, LVALUEtoCELL(i));
+    return;
+}
+
+static void twoDiv(FICL_VM *pVM)
+{
+    INT32 i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    i = stackGetTop(pVM->pStack).i;
+    i >>= 1;
+    stackSetTop(pVM->pStack, LVALUEtoCELL(i));
+    return;
+}
+
+static void mulDiv(FICL_VM *pVM)
+{
+    INT32 x, y, z;
+    INT64 prod;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 3, 1);
+#endif
+    z = stackPopINT32(pVM->pStack);
+    y = stackPopINT32(pVM->pStack);
+    x = stackPopINT32(pVM->pStack);
+
+    prod = m64MulI(x,y);
+    x    = m64SymmetricDivI(prod, z).quot;
+
+    stackPushINT32(pVM->pStack, x);
+    return;
+}
+
+
+static void mulDivRem(FICL_VM *pVM)
+{
+    INT32 x, y, z;
+    INT64 prod;
+    INTQR qr;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 3, 2);
+#endif
+    z = stackPopINT32(pVM->pStack);
+    y = stackPopINT32(pVM->pStack);
+    x = stackPopINT32(pVM->pStack);
+
+    prod = m64MulI(x,y);
+    qr   = m64SymmetricDivI(prod, z);
+
+    stackPushINT32(pVM->pStack, qr.rem);
+    stackPushINT32(pVM->pStack, qr.quot);
+    return;
+}
+
+
+/**************************************************************************
+                        b y e
+** TOOLS
+** Signal the system to shut down - this causes ficlExec to return
+** VM_USEREXIT. The rest is up to you.
+**************************************************************************/
+
+static void bye(FICL_VM *pVM)
+{
+    vmThrow(pVM, VM_USEREXIT);
+    return;
+}
+
+
+/**************************************************************************
+                        c o l o n   d e f i n i t i o n s
+** Code to begin compiling a colon definition
+** This function sets the state to COMPILE, then creates a
+** new word whose name is the next word in the input stream
+** and whose code is colonParen.
+**************************************************************************/
+
+static void colon(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    STRINGINFO si = vmGetWord(pVM);
+
+    pVM->state = COMPILE;
+    markControlTag(pVM, colonTag);
+    dictAppendWord2(dp, si, colonParen, FW_DEFAULT | FW_SMUDGE);
+#if FICL_WANT_LOCALS
+    nLocals = 0;
+#endif
+    return;
+}
+
+
+/**************************************************************************
+                        c o l o n P a r e n
+** This is the code that executes a colon definition. It assumes that the
+** virtual machine is running a "next" loop (See the vm.c
+** for its implementation of member function vmExecute()). The colon
+** code simply copies the address of the first word in the list of words
+** to interpret into IP after saving its old value. When we return to the
+** "next" loop, the virtual machine will call the code for each word in 
+** turn.
+**
+**************************************************************************/
+       
+static void colonParen(FICL_VM *pVM)
+{
+    IPTYPE tempIP = (IPTYPE) (pVM->runningWord->param);
+    vmPushIP(pVM, tempIP);
+
+    return;
+}
+
+
+/**************************************************************************
+                        s e m i c o l o n C o I m
+** 
+** IMMEDIATE code for ";". This function sets the state to INTERPRET and
+** terminates a word under compilation by appending code for "(;)" to
+** the definition. TO DO: checks for leftover branch target tags on the
+** return stack and complains if any are found.
+**************************************************************************/
+static void semiParen(FICL_VM *pVM)
+{
+    vmPopIP(pVM);
+    return;
+}
+
+
+static void semicolonCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pSemiParen);
+    matchControlTag(pVM, colonTag);
+
+#if FICL_WANT_LOCALS
+    assert(pUnLinkParen);
+    if (nLocals > 0)
+    {
+        FICL_DICT *pLoc = ficlGetLoc();
+        dictEmpty(pLoc, pLoc->pForthWords->size);
+        dictAppendCell(dp, LVALUEtoCELL(pUnLinkParen));
+    }
+    nLocals = 0;
+#endif
+
+    dictAppendCell(dp, LVALUEtoCELL(pSemiParen));
+    pVM->state = INTERPRET;
+    dictUnsmudge(dp);
+    return;
+}
+
+
+/**************************************************************************
+                        e x i t
+** CORE
+** This function simply pops the previous instruction
+** pointer and returns to the "next" loop. Used for exiting from within
+** a definition. Note that exitParen is identical to semiParen - they
+** are in two different functions so that "see" can correctly identify
+** the end of a colon definition, even if it uses "exit".
+**************************************************************************/
+static void exitParen(FICL_VM *pVM)
+{
+    vmPopIP(pVM);
+    return;
+}
+
+static void exitCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    assert(pExitParen);
+    IGNORE(pVM);
+
+#if FICL_WANT_LOCALS
+    if (nLocals > 0)
+    {
+        dictAppendCell(dp, LVALUEtoCELL(pUnLinkParen));
+    }
+#endif
+    dictAppendCell(dp, LVALUEtoCELL(pExitParen));
+    return;
+}
+
+
+/**************************************************************************
+                        c o n s t a n t P a r e n
+** This is the run-time code for "constant". It simply returns the 
+** contents of its word's first data cell.
+**
+**************************************************************************/
+
+void constantParen(FICL_VM *pVM)
+{
+    FICL_WORD *pFW = pVM->runningWord;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 0, 1);
+#endif
+    stackPush(pVM->pStack, pFW->param[0]);
+    return;
+}
+
+void twoConstParen(FICL_VM *pVM)
+{
+    FICL_WORD *pFW = pVM->runningWord;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 0, 2);
+#endif
+    stackPush(pVM->pStack, pFW->param[0]); /* lo */
+    stackPush(pVM->pStack, pFW->param[1]); /* hi */
+    return;
+}
+
+
+/**************************************************************************
+                        c o n s t a n t
+** IMMEDIATE
+** Compiles a constant into the dictionary. Constants return their
+** value when invoked. Expects a value on top of the parm stack.
+**************************************************************************/
+
+static void constant(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    STRINGINFO si = vmGetWord(pVM);
+
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+#endif
+    dictAppendWord2(dp, si, constantParen, FW_DEFAULT);
+    dictAppendCell(dp, stackPop(pVM->pStack));
+    return;
+}
+
+
+static void twoConstant(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    STRINGINFO si = vmGetWord(pVM);
+    CELL c;
+    
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 0);
+#endif
+    c = stackPop(pVM->pStack);
+    dictAppendWord2(dp, si, twoConstParen, FW_DEFAULT);
+    dictAppendCell(dp, stackPop(pVM->pStack));
+    dictAppendCell(dp, c);
+    return;
+}
+
+
+/**************************************************************************
+                        d i s p l a y C e l l
+** Drop and print the contents of the cell at the top of the param
+** stack
+**************************************************************************/
+
+static void displayCell(FICL_VM *pVM)
+{
+    CELL c;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+#endif
+    c = stackPop(pVM->pStack);
+    ltoa((c).i, pVM->pad, pVM->base);
+    strcat(pVM->pad, " ");
+    vmTextOut(pVM, pVM->pad, 0);
+    return;
+}
+
+static void uDot(FICL_VM *pVM)
+{
+    UNS32 u;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+#endif
+    u = stackPopUNS32(pVM->pStack);
+    ultoa(u, pVM->pad, pVM->base);
+    strcat(pVM->pad, " ");
+    vmTextOut(pVM, pVM->pad, 0);
+    return;
+}
+
+
+static void hexDot(FICL_VM *pVM)
+{
+    UNS32 u;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+#endif
+    u = stackPopUNS32(pVM->pStack);
+    ultoa(u, pVM->pad, 16);
+    strcat(pVM->pad, " ");
+    vmTextOut(pVM, pVM->pad, 0);
+    return;
+}
+
+
+/**************************************************************************
+                        d i s p l a y S t a c k
+** Display the parameter stack (code for ".s")
+**************************************************************************/
+
+static void displayStack(FICL_VM *pVM)
+{
+    int d = stackDepth(pVM->pStack);
+    int i;
+    CELL *pCell;
+
+    vmCheckStack(pVM, 0, 0);
+
+    if (d == 0)
+        vmTextOut(pVM, "(Stack Empty)", 1);
+    else
+    {
+        pCell = pVM->pStack->sp;
+        for (i = 0; i < d; i++)
+        {
+            vmTextOut(pVM, ltoa((*--pCell).i, pVM->pad, pVM->base), 1);
+        }
+    }
+}
+
+
+/**************************************************************************
+                        d u p   &   f r i e n d s
+** 
+**************************************************************************/
+
+static void depth(FICL_VM *pVM)
+{
+    int i;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 0, 1);
+#endif
+    i = stackDepth(pVM->pStack);
+    stackPushINT32(pVM->pStack, i);
+    return;
+}
+
+
+static void drop(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+#endif
+    stackDrop(pVM->pStack, 1);
+    return;
+}
+
+
+static void twoDrop(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 0);
+#endif
+    stackDrop(pVM->pStack, 2);
+    return;
+}
+
+
+static void dup(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 2);
+#endif
+    stackPick(pVM->pStack, 0);
+    return;
+}
+
+
+static void twoDup(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 4);
+#endif
+    stackPick(pVM->pStack, 1);
+    stackPick(pVM->pStack, 1);
+    return;
+}
+
+
+static void over(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 3);
+#endif
+    stackPick(pVM->pStack, 1);
+    return;
+}
+
+static void twoOver(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 4, 6);
+#endif
+    stackPick(pVM->pStack, 3);
+    stackPick(pVM->pStack, 3);
+    return;
+}
+
+
+static void pick(FICL_VM *pVM)
+{
+    CELL c = stackPop(pVM->pStack);
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, c.i+1, c.i+2);
+#endif
+    stackPick(pVM->pStack, c.i);
+    return;
+}
+
+
+static void questionDup(FICL_VM *pVM)
+{
+    CELL c;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 2);
+#endif
+    c = stackGetTop(pVM->pStack);
+
+    if (c.i != 0)
+        stackPick(pVM->pStack, 0);
+
+    return;
+}
+
+
+static void roll(FICL_VM *pVM)
+{
+    int i = stackPop(pVM->pStack).i;
+    i = (i > 0) ? i : 0;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, i+1, i+1);
+#endif
+    stackRoll(pVM->pStack, i);
+    return;
+}
+
+
+static void minusRoll(FICL_VM *pVM)
+{
+    int i = stackPop(pVM->pStack).i;
+    i = (i > 0) ? i : 0;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, i+1, i+1);
+#endif
+    stackRoll(pVM->pStack, -i);
+    return;
+}
+
+
+static void rot(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 3, 3);
+#endif
+    stackRoll(pVM->pStack, 2);
+    return;
+}
+
+
+static void swap(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 2);
+#endif
+    stackRoll(pVM->pStack, 1);
+    return;
+}
+
+
+static void twoSwap(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 4, 4);
+#endif
+    stackRoll(pVM->pStack, 3);
+    stackRoll(pVM->pStack, 3);
+    return;
+}
+
+
+/**************************************************************************
+                        e m i t   &   f r i e n d s
+** 
+**************************************************************************/
+
+static void emit(FICL_VM *pVM)
+{
+    char *cp = pVM->pad;
+    int i;
+
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+#endif
+    i = stackPopINT32(pVM->pStack);
+    cp[0] = (char)i;
+    cp[1] = '\0';
+    vmTextOut(pVM, cp, 0);
+    return;
+}
+
+
+static void cr(FICL_VM *pVM)
+{
+    vmTextOut(pVM, "", 1);
+    return;
+}
+
+
+static void commentLine(FICL_VM *pVM)
+{
+    char *cp = vmGetInBuf(pVM);
+    char ch = *cp;
+
+    while ((ch != '\0') && (ch != '\r') && (ch != '\n'))
+    {
+        ch = *++cp;
+    }
+
+    /*
+    ** Cope with DOS or UNIX-style EOLs -
+    ** Check for /r, /n, /r/n, or /n/r end-of-line sequences,
+    ** and point cp to next char. If EOL is \0, we're done.
+    */
+    if (ch != '\0')
+    {
+        cp++;
+
+        if ( (ch != *cp) 
+             && ((*cp == '\r') || (*cp == '\n')) )
+            cp++;
+    }
+
+    vmUpdateTib(pVM, cp);
+    return;
+}
+
+
+/*
+** paren CORE 
+** Compilation: Perform the execution semantics given below.
+** Execution: ( "ccc<paren>" -- )
+** Parse ccc delimited by ) (right parenthesis). ( is an immediate word. 
+** The number of characters in ccc may be zero to the number of characters
+** in the parse area. 
+** 
+*/
+static void commentHang(FICL_VM *pVM)
+{
+    vmParseString(pVM, ')');
+    return;
+}
+
+
+/**************************************************************************
+                        F E T C H   &   S T O R E
+** 
+**************************************************************************/
+
+static void fetch(FICL_VM *pVM)
+{
+    CELL *pCell;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    pCell = (CELL *)stackPopPtr(pVM->pStack);
+    stackPush(pVM->pStack, *pCell);
+    return;
+}
+
+/*
+** two-fetch    CORE ( a-addr -- x1 x2 )
+** Fetch the cell pair x1 x2 stored at a-addr. x2 is stored at a-addr and
+** x1 at the next consecutive cell. It is equivalent to the sequence
+** DUP CELL+ @ SWAP @ . 
+*/
+static void twoFetch(FICL_VM *pVM)
+{
+    CELL *pCell;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 2);
+#endif
+    pCell = (CELL *)stackPopPtr(pVM->pStack);
+    stackPush(pVM->pStack, *pCell++);
+    stackPush(pVM->pStack, *pCell);
+    swap(pVM);
+    return;
+}
+
+/*
+** store        CORE ( x a-addr -- )
+** Store x at a-addr. 
+*/
+static void store(FICL_VM *pVM)
+{
+    CELL *pCell;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 0);
+#endif
+    pCell = (CELL *)stackPopPtr(pVM->pStack);
+    *pCell = stackPop(pVM->pStack);
+}
+
+/*
+** two-store    CORE ( x1 x2 a-addr -- )
+** Store the cell pair x1 x2 at a-addr, with x2 at a-addr and x1 at the
+** next consecutive cell. It is equivalent to the sequence
+** SWAP OVER ! CELL+ ! . 
+*/
+static void twoStore(FICL_VM *pVM)
+{
+    CELL *pCell;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 3, 0);
+#endif
+    pCell = (CELL *)stackPopPtr(pVM->pStack);
+    *pCell++    = stackPop(pVM->pStack);
+    *pCell      = stackPop(pVM->pStack);
+}
+
+static void plusStore(FICL_VM *pVM)
+{
+    CELL *pCell;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 0);
+#endif
+    pCell = (CELL *)stackPopPtr(pVM->pStack);
+    pCell->i += stackPop(pVM->pStack).i;
+}
+
+
+static void wFetch(FICL_VM *pVM)
+{
+    UNS16 *pw;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    pw = (UNS16 *)stackPopPtr(pVM->pStack);
+    stackPushUNS32(pVM->pStack, (UNS32)*pw);
+    return;
+}
+
+static void wStore(FICL_VM *pVM)
+{
+    UNS16 *pw;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 0);
+#endif
+    pw = (UNS16 *)stackPopPtr(pVM->pStack);
+    *pw = (UNS16)(stackPop(pVM->pStack).u);
+}
+
+static void cFetch(FICL_VM *pVM)
+{
+    UNS8 *pc;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    pc = (UNS8 *)stackPopPtr(pVM->pStack);
+    stackPushUNS32(pVM->pStack, (UNS32)*pc);
+    return;
+}
+
+static void cStore(FICL_VM *pVM)
+{
+    UNS8 *pc;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 0);
+#endif
+    pc = (UNS8 *)stackPopPtr(pVM->pStack);
+    *pc = (UNS8)(stackPop(pVM->pStack).u);
+}
+
+
+/**************************************************************************
+                        i f C o I m
+** IMMEDIATE
+** Compiles code for a conditional branch into the dictionary
+** and pushes the branch patch address on the stack for later
+** patching by ELSE or THEN/ENDIF. 
+**************************************************************************/
+
+static void ifCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pIfParen);
+
+    dictAppendCell(dp, LVALUEtoCELL(pIfParen));
+    markBranch(dp, pVM, ifTag);
+    dictAppendUNS32(dp, 1);
+    return;
+}
+
+
+/**************************************************************************
+                        i f P a r e n
+** Runtime code to do "if" or "until": pop a flag from the stack,
+** fall through if true, branch if false. Probably ought to be 
+** called (not?branch) since it does "branch if false".
+**************************************************************************/
+
+static void ifParen(FICL_VM *pVM)
+{
+    UNS32 flag;
+    
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+#endif
+    flag = stackPopUNS32(pVM->pStack);
+
+    if (flag) 
+    {                           /* fall through */
+        vmBranchRelative(pVM, 1);
+    }
+    else 
+    {                           /* take branch (to else/endif/begin) */
+        vmBranchRelative(pVM, (int)(*pVM->ip));
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        e l s e C o I m
+** 
+** IMMEDIATE -- compiles an "else"...
+** 1) Compile a branch and a patch address; the address gets patched
+**    by "endif" to point past the "else" code.
+** 2) Pop the the "if" patch address
+** 3) Patch the "if" branch to point to the current compile address.
+** 4) Push the "else" patch address. ("endif" patches this to jump past 
+**    the "else" code.
+**************************************************************************/
+
+static void elseCoIm(FICL_VM *pVM)
+{
+    CELL *patchAddr;
+    int offset;
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pBranchParen);
+                                            /* (1) compile branch runtime */
+    dictAppendCell(dp, LVALUEtoCELL(pBranchParen));
+    matchControlTag(pVM, ifTag);
+    patchAddr = 
+        (CELL *)stackPopPtr(pVM->pStack);   /* (2) pop "if" patch addr */
+    markBranch(dp, pVM, ifTag);             /* (4) push "else" patch addr */
+    dictAppendUNS32(dp, 1);                 /* (1) compile patch placeholder */
+    offset = dp->here - patchAddr;
+    *patchAddr = LVALUEtoCELL(offset);      /* (3) Patch "if" */
+
+    return;
+}
+
+
+/**************************************************************************
+                        b r a n c h P a r e n
+** 
+** Runtime for "(branch)" -- expects a literal offset in the next
+** compilation address, and branches to that location.
+**************************************************************************/
+
+static void branchParen(FICL_VM *pVM)
+{
+    vmBranchRelative(pVM, *(int *)(pVM->ip));
+    return;
+}
+
+
+/**************************************************************************
+                        e n d i f C o I m
+** 
+**************************************************************************/
+
+static void endifCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    resolveForwardBranch(dp, pVM, ifTag);
+    return;
+}
+
+
+/**************************************************************************
+                        i n t e r p r e t 
+** This is the "user interface" of a Forth. It does the following:
+**   while there are words in the VM's Text Input Buffer
+**     Copy next word into the pad (vmGetWord)
+**     Attempt to find the word in the dictionary (dictLookup)
+**     If successful, execute the word.
+**     Otherwise, attempt to convert the word to a number (isNumber)
+**     If successful, push the number onto the parameter stack.
+**     Otherwise, print an error message and exit loop...
+**   End Loop
+**
+** From the standard, section 3.4
+** Text interpretation (see 6.1.1360 EVALUATE and 6.1.2050 QUIT) shall
+** repeat the following steps until either the parse area is empty or an 
+** ambiguous condition exists: 
+** a) Skip leading spaces and parse a name (see 3.4.1); 
+**************************************************************************/
+
+static void interpret(FICL_VM *pVM)
+{
+    STRINGINFO si = vmGetWord0(pVM);
+    assert(pVM);
+
+    vmBranchRelative(pVM, -1);
+
+    /*
+    // Get next word...if out of text, we're done.
+    */
+    if (si.count == 0)
+    {
+        vmThrow(pVM, VM_OUTOFTEXT);
+    }
+
+    interpWord(pVM, si);
+
+
+    return;                 /* back to inner interpreter */
+}
+
+/**************************************************************************
+** From the standard, section 3.4
+** b) Search the dictionary name space (see 3.4.2). If a definition name
+** matching the string is found: 
+**  1.if interpreting, perform the interpretation semantics of the definition
+**  (see 3.4.3.2), and continue at a); 
+**  2.if compiling, perform the compilation semantics of the definition
+**  (see 3.4.3.3), and continue at a). 
+**
+** c) If a definition name matching the string is not found, attempt to
+** convert the string to a number (see 3.4.1.3). If successful: 
+**  1.if interpreting, place the number on the data stack, and continue at a); 
+**  2.if compiling, compile code that when executed will place the number on
+**  the stack (see 6.1.1780 LITERAL), and continue at a); 
+**
+** d) If unsuccessful, an ambiguous condition exists (see 3.4.4). 
+**************************************************************************/
+static void interpWord(FICL_VM *pVM, STRINGINFO si)
+{
+    FICL_DICT *dp = ficlGetDict();
+    FICL_WORD *tempFW;
+
+#if FICL_ROBUST
+    dictCheck(dp, pVM, 0);
+    vmCheckStack(pVM, 0, 0);
+#endif
+
+#if FICL_WANT_LOCALS
+    if (nLocals > 0)
+    {
+        tempFW = dictLookupLoc(dp, si);
+    }
+    else
+#endif
+    tempFW = dictLookup(dp, si);
+
+    if (pVM->state == INTERPRET)
+    {
+        if (tempFW != NULL)
+        {
+            if (wordIsCompileOnly(tempFW))
+            {
+                vmThrowErr(pVM, "Error: Compile only!");
+            }
+
+            vmExecute(pVM, tempFW);
+        }
+
+        else if (!isNumber(pVM, si))
+        {
+            int i = SI_COUNT(si);
+            vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
+        }
+    }
+
+    else /* (pVM->state == COMPILE) */
+    {
+        if (tempFW != NULL)
+        {
+            if (wordIsImmediate(tempFW))
+            {
+                vmExecute(pVM, tempFW);
+            }
+            else
+            {
+                dictAppendCell(dp, LVALUEtoCELL(tempFW));
+            }
+        }
+        else if (isNumber(pVM, si))
+        {
+            literalIm(pVM);
+        }
+        else
+        {
+            int i = SI_COUNT(si);
+            vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
+        }
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        l i t e r a l P a r e n
+** 
+** This is the runtime for (literal). It assumes that it is part of a colon
+** definition, and that the next CELL contains a value to be pushed on the
+** parameter stack at runtime. This code is compiled by "literal".
+**
+**************************************************************************/
+
+static void literalParen(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 0, 1);
+#endif
+    stackPushINT32(pVM->pStack, *(INT32 *)(pVM->ip));
+    vmBranchRelative(pVM, 1);
+    return;
+}
+
+
+/**************************************************************************
+                        l i t e r a l I m
+** 
+** IMMEDIATE code for "literal". This function gets a value from the stack 
+** and compiles it into the dictionary preceded by the code for "(literal)".
+** IMMEDIATE
+**************************************************************************/
+
+static void literalIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    assert(pLitParen);
+
+    dictAppendCell(dp, LVALUEtoCELL(pLitParen));
+    dictAppendCell(dp, stackPop(pVM->pStack));
+
+    return;
+}
+
+
+/**************************************************************************
+                        l i s t W o r d s
+** 
+**************************************************************************/
+#define nCOLWIDTH 8
+static void listWords(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    FICL_HASH *pHash = dp->pSearch[dp->nLists - 1];
+    FICL_WORD *wp;
+    int nChars = 0;
+    int len;
+    unsigned i;
+    int nWords = 0;
+    char *cp;
+    char *pPad = pVM->pad;
+
+    for (i = 0; i < pHash->size; i++)
+    {
+        for (wp = pHash->table[i]; wp != NULL; wp = wp->link, nWords++)
+        {
+            if (wp->nName == 0) /* ignore :noname defs */
+                continue;
+
+            cp = wp->name;
+            nChars += sprintf(pPad + nChars, "%s", cp);
+
+            if (nChars > 70)
+            {
+                pPad[nChars] = '\0';
+                nChars = 0;
+                vmTextOut(pVM, pPad, 1);
+            }
+            else
+            {
+                len = nCOLWIDTH - nChars % nCOLWIDTH;
+                while (len-- > 0)
+                    pPad[nChars++] = ' ';
+            }
+
+            if (nChars > 70)
+            {
+                pPad[nChars] = '\0';
+                nChars = 0;
+                vmTextOut(pVM, pPad, 1);
+            }
+        }
+    }
+
+    if (nChars > 0)
+    {
+        pPad[nChars] = '\0';
+        nChars = 0;
+        vmTextOut(pVM, pPad, 1);
+    }
+
+    sprintf(pVM->pad, "Dictionary: %d words, %ld cells used of %lu total", 
+        nWords, dp->here - dp->dict, dp->size);
+    vmTextOut(pVM, pVM->pad, 1);
+    return;
+}
+
+
+static void listEnv(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetEnv();
+    FICL_HASH *pHash = dp->pForthWords;
+    FICL_WORD *wp;
+    unsigned i;
+    int nWords = 0;
+
+    for (i = 0; i < pHash->size; i++)
+    {
+        for (wp = pHash->table[i]; wp != NULL; wp = wp->link, nWords++)
+        {
+            vmTextOut(pVM, wp->name, 1);
+        }
+    }
+
+    sprintf(pVM->pad, "Environment: %d words, %ld cells used of %lu total", 
+        nWords, dp->here - dp->dict, dp->size);
+    vmTextOut(pVM, pVM->pad, 1);
+    return;
+}
+
+
+/**************************************************************************
+                        l o g i c   a n d   c o m p a r i s o n s
+** 
+**************************************************************************/
+
+static void zeroEquals(FICL_VM *pVM)
+{
+    CELL c;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    c.i = FICL_BOOL(stackPopINT32(pVM->pStack) == 0);
+    stackPush(pVM->pStack, c);
+    return;
+}
+
+static void zeroLess(FICL_VM *pVM)
+{
+    CELL c;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    c.i = FICL_BOOL(stackPopINT32(pVM->pStack) < 0);
+    stackPush(pVM->pStack, c);
+    return;
+}
+
+static void zeroGreater(FICL_VM *pVM)
+{
+    CELL c;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    c.i = FICL_BOOL(stackPopINT32(pVM->pStack) > 0);
+    stackPush(pVM->pStack, c);
+    return;
+}
+
+static void isEqual(FICL_VM *pVM)
+{
+    CELL x, y;
+
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    x = stackPop(pVM->pStack);
+    y = stackPop(pVM->pStack);
+    stackPushINT32(pVM->pStack, FICL_BOOL(x.i == y.i));
+    return;
+}
+
+static void isLess(FICL_VM *pVM)
+{
+    CELL x, y;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    y = stackPop(pVM->pStack);
+    x = stackPop(pVM->pStack);
+    stackPushINT32(pVM->pStack, FICL_BOOL(x.i < y.i));
+    return;
+}
+
+static void uIsLess(FICL_VM *pVM)
+{
+    UNS32 u1, u2;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    u2 = stackPopUNS32(pVM->pStack);
+    u1 = stackPopUNS32(pVM->pStack);
+    stackPushINT32(pVM->pStack, FICL_BOOL(u1 < u2));
+    return;
+}
+
+static void isGreater(FICL_VM *pVM)
+{
+    CELL x, y;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    y = stackPop(pVM->pStack);
+    x = stackPop(pVM->pStack);
+    stackPushINT32(pVM->pStack, FICL_BOOL(x.i > y.i));
+    return;
+}
+
+static void bitwiseAnd(FICL_VM *pVM)
+{
+    CELL x, y;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    x = stackPop(pVM->pStack);
+    y = stackPop(pVM->pStack);
+    stackPushINT32(pVM->pStack, x.i & y.i);
+    return;
+}
+
+static void bitwiseOr(FICL_VM *pVM)
+{
+    CELL x, y;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    x = stackPop(pVM->pStack);
+    y = stackPop(pVM->pStack);
+    stackPushINT32(pVM->pStack, x.i | y.i);
+    return;
+}
+
+static void bitwiseXor(FICL_VM *pVM)
+{
+    CELL x, y;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 1);
+#endif
+    x = stackPop(pVM->pStack);
+    y = stackPop(pVM->pStack);
+    stackPushINT32(pVM->pStack, x.i ^ y.i);
+    return;
+}
+
+static void bitwiseNot(FICL_VM *pVM)
+{
+    CELL x;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    x = stackPop(pVM->pStack);
+    stackPushINT32(pVM->pStack, ~x.i);
+    return;
+}
+
+
+/**************************************************************************
+                               D o  /  L o o p
+** do -- IMMEDIATE COMPILE ONLY
+**    Compiles code to initialize a loop: compile (do), 
+**    allot space to hold the "leave" address, push a branch
+**    target address for the loop.
+** (do) -- runtime for "do"
+**    pops index and limit from the p stack and moves them
+**    to the r stack, then skips to the loop body.
+** loop -- IMMEDIATE COMPILE ONLY
+** +loop
+**    Compiles code for the test part of a loop:
+**    compile (loop), resolve forward branch from "do", and
+**    copy "here" address to the "leave" address allotted by "do"
+** i,j,k -- COMPILE ONLY
+**    Runtime: Push loop indices on param stack (i is innermost loop...)
+**    Note: each loop has three values on the return stack:
+**    ( R: leave limit index )
+**    "leave" is the absolute address of the next cell after the loop
+**    limit and index are the loop control variables.
+** leave -- COMPILE ONLY
+**    Runtime: pop the loop control variables, then pop the
+**    "leave" address and jump (absolute) there.
+**************************************************************************/
+
+static void doCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pDoParen);
+
+    dictAppendCell(dp, LVALUEtoCELL(pDoParen));
+    /*
+    ** Allot space for a pointer to the end
+    ** of the loop - "leave" uses this...
+    */
+    markBranch(dp, pVM, leaveTag);
+    dictAppendUNS32(dp, 0);
+    /*
+    ** Mark location of head of loop...
+    */
+    markBranch(dp, pVM, doTag);
+
+    return;
+}
+
+
+static void doParen(FICL_VM *pVM)
+{
+    CELL index, limit;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 0);
+#endif
+    index = stackPop(pVM->pStack);
+    limit = stackPop(pVM->pStack);
+
+    /* copy "leave" target addr to stack */
+    stackPushPtr(pVM->rStack, *(pVM->ip++));
+    stackPush(pVM->rStack, limit);
+    stackPush(pVM->rStack, index);
+
+    return;
+}
+
+
+static void qDoCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pQDoParen);
+
+    dictAppendCell(dp, LVALUEtoCELL(pQDoParen));
+    /*
+    ** Allot space for a pointer to the end
+    ** of the loop - "leave" uses this...
+    */
+    markBranch(dp, pVM, leaveTag);
+    dictAppendUNS32(dp, 0);
+    /*
+    ** Mark location of head of loop...
+    */
+    markBranch(dp, pVM, doTag);
+
+    return;
+}
+
+
+static void qDoParen(FICL_VM *pVM)
+{
+    CELL index, limit;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 0);
+#endif
+    index = stackPop(pVM->pStack);
+    limit = stackPop(pVM->pStack);
+
+    /* copy "leave" target addr to stack */
+    stackPushPtr(pVM->rStack, *(pVM->ip++));
+
+    if (limit.u == index.u)
+    {
+        vmPopIP(pVM);
+    }
+    else
+    {
+        stackPush(pVM->rStack, limit);
+        stackPush(pVM->rStack, index);
+    }
+
+    return;
+}
+
+
+/*
+** Runtime code to break out of a do..loop construct
+** Drop the loop control variables; the branch address
+** past "loop" is next on the return stack.
+*/
+static void leaveCo(FICL_VM *pVM)
+{
+    /* almost unloop */
+    stackDrop(pVM->rStack, 2);
+    /* exit */
+    vmPopIP(pVM);
+    return;
+}
+
+
+static void unloopCo(FICL_VM *pVM)
+{
+    stackDrop(pVM->rStack, 3);
+    return;
+}
+
+
+static void loopCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pLoopParen);
+
+    dictAppendCell(dp, LVALUEtoCELL(pLoopParen));
+    resolveBackBranch(dp, pVM, doTag);
+    resolveAbsBranch(dp, pVM, leaveTag);
+    return;
+}
+
+
+static void plusLoopCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pPLoopParen);
+
+    dictAppendCell(dp, LVALUEtoCELL(pPLoopParen));
+    resolveBackBranch(dp, pVM, doTag);
+    resolveAbsBranch(dp, pVM, leaveTag);
+    return;
+}
+
+
+static void loopParen(FICL_VM *pVM)
+{
+    INT32 index = stackGetTop(pVM->rStack).i;
+    INT32 limit = stackFetch(pVM->rStack, 1).i;
+
+    index++;
+
+    if (index >= limit) 
+    {
+        stackDrop(pVM->rStack, 3); /* nuke the loop indices & "leave" addr */
+        vmBranchRelative(pVM, 1);  /* fall through the loop */
+    }
+    else 
+    {                       /* update index, branch to loop head */
+        stackSetTop(pVM->rStack, LVALUEtoCELL(index));
+        vmBranchRelative(pVM, *(int *)(pVM->ip));
+    }
+
+    return;
+}
+
+
+static void plusLoopParen(FICL_VM *pVM)
+{
+    INT32 index = stackGetTop(pVM->rStack).i;
+    INT32 limit = stackFetch(pVM->rStack, 1).i;
+    INT32 increment = stackPop(pVM->pStack).i;
+    int flag;
+
+    index += increment;
+
+    if (increment < 0)
+        flag = (index < limit);
+    else
+        flag = (index >= limit);
+
+    if (flag) 
+    {
+        stackDrop(pVM->rStack, 3); /* nuke the loop indices & "leave" addr */
+        vmBranchRelative(pVM, 1);  /* fall through the loop */
+    }
+    else 
+    {                       /* update index, branch to loop head */
+        stackSetTop(pVM->rStack, LVALUEtoCELL(index));
+        vmBranchRelative(pVM, *(int *)(pVM->ip));
+    }
+
+    return;
+}
+
+
+static void loopICo(FICL_VM *pVM)
+{
+    CELL index = stackGetTop(pVM->rStack);
+    stackPush(pVM->pStack, index);
+
+    return;
+}
+
+
+static void loopJCo(FICL_VM *pVM)
+{
+    CELL index = stackFetch(pVM->rStack, 3);
+    stackPush(pVM->pStack, index);
+
+    return;
+}
+
+
+static void loopKCo(FICL_VM *pVM)
+{
+    CELL index = stackFetch(pVM->rStack, 6);
+    stackPush(pVM->pStack, index);
+
+    return;
+}
+
+
+/**************************************************************************
+                        r e t u r n   s t a c k
+** 
+**************************************************************************/
+
+static void toRStack(FICL_VM *pVM)
+{
+    stackPush(pVM->rStack, stackPop(pVM->pStack));
+    return;
+}
+
+static void fromRStack(FICL_VM *pVM)
+{
+    stackPush(pVM->pStack, stackPop(pVM->rStack));
+    return;
+}
+
+static void fetchRStack(FICL_VM *pVM)
+{
+    stackPush(pVM->pStack, stackGetTop(pVM->rStack));
+    return;
+}
+
+
+/**************************************************************************
+                        v a r i a b l e
+** 
+**************************************************************************/
+
+static void variableParen(FICL_VM *pVM)
+{
+    FICL_WORD *fw = pVM->runningWord;
+    stackPushPtr(pVM->pStack, fw->param);
+    return;
+}
+
+
+static void variable(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    STRINGINFO si = vmGetWord(pVM);
+
+    dictAppendWord2(dp, si, variableParen, FW_DEFAULT);
+    dictAllotCells(dp, 1);
+    return;
+}
+
+
+
+/**************************************************************************
+                        b a s e   &   f r i e n d s
+** 
+**************************************************************************/
+
+static void base(FICL_VM *pVM)
+{
+    CELL *pBase = (CELL *)(&pVM->base);
+    stackPush(pVM->pStack, LVALUEtoCELL(pBase));
+    return;
+}
+
+
+static void decimal(FICL_VM *pVM)
+{
+    pVM->base = 10;
+    return;
+}
+
+
+static void hex(FICL_VM *pVM)
+{
+    pVM->base = 16;
+    return;
+}
+
+
+/**************************************************************************
+                        a l l o t   &   f r i e n d s
+** 
+**************************************************************************/
+
+static void allot(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    INT32 i = stackPopINT32(pVM->pStack);
+#if FICL_ROBUST
+    dictCheck(dp, pVM, i);
+#endif
+    dictAllot(dp, i);
+    return;
+}
+
+
+static void here(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    stackPushPtr(pVM->pStack, dp->here);
+    return;
+}
+
+
+static void comma(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    CELL c = stackPop(pVM->pStack);
+    dictAppendCell(dp, c);
+    return;
+}
+
+
+static void cComma(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    char c = (char)stackPopINT32(pVM->pStack);
+    dictAppendChar(dp, c);
+    return;
+}
+
+
+static void cells(FICL_VM *pVM)
+{
+    INT32 i = stackPopINT32(pVM->pStack);
+    stackPushINT32(pVM->pStack, i * (INT32)sizeof (CELL));
+    return;
+}
+
+
+static void cellPlus(FICL_VM *pVM)
+{
+    char *cp = stackPopPtr(pVM->pStack);
+    stackPushPtr(pVM->pStack, cp + sizeof (CELL));
+    return;
+}
+
+
+/**************************************************************************
+                        t i c k
+** tick         CORE ( "<spaces>name" -- xt )
+** Skip leading space delimiters. Parse name delimited by a space. Find
+** name and return xt, the execution token for name. An ambiguous condition
+** exists if name is not found. 
+**************************************************************************/
+static void tick(FICL_VM *pVM)
+{
+    FICL_WORD *pFW = NULL;
+    STRINGINFO si = vmGetWord(pVM);
+    
+    pFW = dictLookup(ficlGetDict(), si);
+    if (!pFW)
+    {
+        int i = SI_COUNT(si);
+        vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
+    }
+    stackPushPtr(pVM->pStack, pFW);
+    return;
+}
+
+
+static void bracketTickCoIm(FICL_VM *pVM)
+{
+    tick(pVM);
+    literalIm(pVM);
+    
+    return;
+}
+
+
+/**************************************************************************
+                        p o s t p o n e
+** Lookup the next word in the input stream and compile code to 
+** insert it into definitions created by the resulting word
+** (defers compilation, even of immediate words)
+**************************************************************************/
+
+static void postponeCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp  = ficlGetDict();
+    FICL_WORD *pFW;
+    assert(pComma);
+
+    tick(pVM);
+    pFW = stackGetTop(pVM->pStack).p;
+    if (wordIsImmediate(pFW))
+    {
+        dictAppendCell(dp, stackPop(pVM->pStack));
+    }
+    else
+    {
+        literalIm(pVM);
+        dictAppendCell(dp, LVALUEtoCELL(pComma));
+    }
+    
+    return;
+}
+
+
+
+/**************************************************************************
+                        e x e c u t e
+** Pop an execution token (pointer to a word) off the stack and
+** run it
+**************************************************************************/
+
+static void execute(FICL_VM *pVM)
+{
+    FICL_WORD *pFW;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    pFW = stackPopPtr(pVM->pStack);
+    vmExecute(pVM, pFW);
+
+    return;
+}
+
+
+/**************************************************************************
+                        i m m e d i a t e
+** Make the most recently compiled word IMMEDIATE -- it executes even
+** in compile state (most often used for control compiling words
+** such as IF, THEN, etc)
+**************************************************************************/
+
+static void immediate(FICL_VM *pVM)
+{
+    IGNORE(pVM);
+    dictSetImmediate(ficlGetDict());
+    return;
+}
+
+
+static void compileOnly(FICL_VM *pVM)
+{
+    IGNORE(pVM);
+    dictSetFlags(ficlGetDict(), FW_COMPILE, 0);
+    return;
+}
+
+
+/**************************************************************************
+                        d o t Q u o t e
+** IMMEDIATE word that compiles a string literal for later display
+** Compile stringLit, then copy the bytes of the string from the TIB
+** to the dictionary. Backpatch the count byte and align the dictionary.
+**
+** stringlit: Fetch the count from the dictionary, then push the address
+** and count on the stack. Finally, update ip to point to the first
+** aligned address after the string text.
+**************************************************************************/
+
+static void stringLit(FICL_VM *pVM)
+{
+    FICL_STRING *sp = (FICL_STRING *)(pVM->ip);
+    FICL_COUNT count = sp->count;
+    char *cp = sp->text;
+    stackPushPtr(pVM->pStack, cp);
+    stackPushUNS32(pVM->pStack, count);
+    cp += count + 1;
+    cp = alignPtr(cp);
+    pVM->ip = (IPTYPE)(void *)cp;
+    return;
+}
+
+static void dotQuoteCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    dictAppendCell(dp, LVALUEtoCELL(pStringLit));
+    dp->here = PTRtoCELL vmGetString(pVM, (FICL_STRING *)dp->here, '\"');
+    dictAlign(dp);
+    dictAppendCell(dp, LVALUEtoCELL(pType));
+    return;
+}
+
+
+static void dotParen(FICL_VM *pVM)
+{
+    char *pSrc  = vmGetInBuf(pVM);
+    char *pDest = pVM->pad;
+    char ch;
+
+    pSrc = skipSpace(pSrc);
+
+    for (ch = *pSrc; (ch != '\0') && (ch != ')'); ch = *++pSrc)
+        *pDest++ = ch;
+
+    *pDest = '\0';
+    if (ch == ')')
+        pSrc++;
+
+    vmTextOut(pVM, pVM->pad, 0);
+    vmUpdateTib(pVM, pSrc);
+        
+    return;
+}
+
+
+/**************************************************************************
+                        s l i t e r a l
+** STRING 
+** Interpretation: Interpretation semantics for this word are undefined.
+** Compilation: ( c-addr1 u -- )
+** Append the run-time semantics given below to the current definition.
+** Run-time:       ( -- c-addr2 u )
+** Return c-addr2 u describing a string consisting of the characters
+** specified by c-addr1 u during compilation. A program shall not alter
+** the returned string. 
+**************************************************************************/
+static void sLiteralCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    char *cp, *cpDest;
+    UNS32 u;
+    u  = stackPopUNS32(pVM->pStack);
+    cp = stackPopPtr(pVM->pStack);
+
+    dictAppendCell(dp, LVALUEtoCELL(pStringLit));
+    cpDest    = (char *) dp->here;
+    *cpDest++ = (char)   u;
+
+    for (; u > 0; --u)
+    {
+        *cpDest++ = *cp++;
+    }
+
+    *cpDest++ = 0;
+    dp->here = PTRtoCELL alignPtr(cpDest);
+    return;
+}
+
+
+/**************************************************************************
+                        s t a t e
+** Return the address of the VM's state member (must be sized the
+** same as a CELL for this reason)
+**************************************************************************/
+static void state(FICL_VM *pVM)
+{
+    stackPushPtr(pVM->pStack, &pVM->state);
+    return;
+}
+
+
+/**************************************************************************
+                        c r e a t e . . . d o e s >
+** Make a new word in the dictionary with the run-time effect of 
+** a variable (push my address), but with extra space allotted
+** for use by does> .
+**************************************************************************/
+
+static void createParen(FICL_VM *pVM)
+{
+    CELL *pCell = pVM->runningWord->param;
+    stackPushPtr(pVM->pStack, pCell+1);
+    return;
+}
+
+
+static void create(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    STRINGINFO si = vmGetWord(pVM);
+
+    dictAppendWord2(dp, si, createParen, FW_DEFAULT);
+    dictAllotCells(dp, 1);
+    return;
+}
+
+
+static void doDoes(FICL_VM *pVM)
+{
+    CELL *pCell = pVM->runningWord->param;
+    IPTYPE tempIP = (IPTYPE)((*pCell).p);
+    stackPushPtr(pVM->pStack, pCell+1);
+    vmPushIP(pVM, tempIP);
+    return;
+}
+
+
+static void doesParen(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    dp->smudge->code = doDoes;
+    dp->smudge->param[0] = LVALUEtoCELL(pVM->ip);
+    vmPopIP(pVM);
+    return;
+}
+
+
+static void doesCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+#if FICL_WANT_LOCALS
+    assert(pUnLinkParen);
+    if (nLocals > 0)
+    {
+        FICL_DICT *pLoc = ficlGetLoc();
+        dictEmpty(pLoc, pLoc->pForthWords->size);
+        dictAppendCell(dp, LVALUEtoCELL(pUnLinkParen));
+    }
+
+    nLocals = 0;
+#endif
+    IGNORE(pVM);
+
+    dictAppendCell(dp, LVALUEtoCELL(pDoesParen));
+    return;
+}
+
+
+/**************************************************************************
+                        t o   b o d y
+** to-body      CORE ( xt -- a-addr )
+** a-addr is the data-field address corresponding to xt. An ambiguous
+** condition exists if xt is not for a word defined via CREATE. 
+**************************************************************************/
+static void toBody(FICL_VM *pVM)
+{
+    FICL_WORD *pFW = stackPopPtr(pVM->pStack);
+    stackPushPtr(pVM->pStack, pFW->param + 1);
+    return;
+}
+
+
+/*
+** from-body       ficl ( a-addr -- xt )
+** Reverse effect of >body
+*/
+static void fromBody(FICL_VM *pVM)
+{
+    char *ptr = (char *) stackPopPtr(pVM->pStack) - sizeof (FICL_WORD);
+    stackPushPtr(pVM->pStack, ptr);
+    return;
+}
+
+
+/*
+** >name        ficl ( xt -- c-addr u )
+** Push the address and length of a word's name given its address
+** xt. 
+*/
+static void toName(FICL_VM *pVM)
+{
+    FICL_WORD *pFW = stackPopPtr(pVM->pStack);
+    stackPushPtr(pVM->pStack, pFW->name);
+    stackPushUNS32(pVM->pStack, pFW->nName);
+    return;
+}
+
+
+/**************************************************************************
+                        l b r a c k e t   e t c
+** 
+**************************************************************************/
+
+static void lbracketCoIm(FICL_VM *pVM)
+{
+    pVM->state = INTERPRET;
+    return;
+}
+
+
+static void rbracket(FICL_VM *pVM)
+{
+    pVM->state = COMPILE;
+    return;
+}
+
+
+/**************************************************************************
+                        p i c t u r e d   n u m e r i c   w o r d s
+**
+** less-number-sign CORE ( -- )
+** Initialize the pictured numeric output conversion process. 
+** (clear the pad)
+**************************************************************************/
+static void lessNumberSign(FICL_VM *pVM)
+{
+    FICL_STRING *sp = PTRtoSTRING pVM->pad;
+    sp->count = 0;
+    return;
+}
+
+/*
+** number-sign      CORE ( ud1 -- ud2 )
+** Divide ud1 by the number in BASE giving the quotient ud2 and the remainder
+** n. (n is the least-significant digit of ud1.) Convert n to external form
+** and add the resulting character to the beginning of the pictured numeric
+** output  string. An ambiguous condition exists if # executes outside of a
+** <# #> delimited number conversion. 
+*/
+static void numberSign(FICL_VM *pVM)
+{
+    FICL_STRING *sp = PTRtoSTRING pVM->pad;
+    UNS64 u;
+    UNS16 rem;
+    
+    u   = u64Pop(pVM->pStack);
+    rem = m64UMod(&u, (UNS16)(pVM->base));
+    sp->text[sp->count++] = digit_to_char(rem);
+    u64Push(pVM->pStack, u);
+    return;
+}
+
+/*
+** number-sign-greater CORE ( xd -- c-addr u )
+** Drop xd. Make the pictured numeric output string available as a character
+** string. c-addr and u specify the resulting character string. A program
+** may replace characters within the string. 
+*/
+static void numberSignGreater(FICL_VM *pVM)
+{
+    FICL_STRING *sp = PTRtoSTRING pVM->pad;
+    sp->text[sp->count] = '\0';
+    strrev(sp->text);
+    stackDrop(pVM->pStack, 2);
+    stackPushPtr(pVM->pStack, sp->text);
+    stackPushUNS32(pVM->pStack, sp->count);
+    return;
+}
+
+/*
+** number-sign-s    CORE ( ud1 -- ud2 )
+** Convert one digit of ud1 according to the rule for #. Continue conversion
+** until the quotient is zero. ud2 is zero. An ambiguous condition exists if
+** #S executes outside of a <# #> delimited number conversion. 
+** TO DO: presently does not use ud1 hi cell - use it!
+*/
+static void numberSignS(FICL_VM *pVM)
+{
+    FICL_STRING *sp = PTRtoSTRING pVM->pad;
+    UNS64 u;
+    UNS16 rem;
+
+    u = u64Pop(pVM->pStack);
+
+    do 
+    {
+        rem = m64UMod(&u, (UNS16)(pVM->base));
+        sp->text[sp->count++] = digit_to_char(rem);
+    } 
+    while (u.hi || u.lo);
+
+    u64Push(pVM->pStack, u);
+    return;
+}
+
+/*
+** HOLD             CORE ( char -- )
+** Add char to the beginning of the pictured numeric output string. An ambiguous
+** condition exists if HOLD executes outside of a <# #> delimited number conversion.
+*/
+static void hold(FICL_VM *pVM)
+{
+    FICL_STRING *sp = PTRtoSTRING pVM->pad;
+    int i = stackPopINT32(pVM->pStack);
+    sp->text[sp->count++] = (char) i;
+    return;
+}
+
+/*
+** SIGN             CORE ( n -- )
+** If n is negative, add a minus sign to the beginning of the pictured
+** numeric output string. An ambiguous condition exists if SIGN
+** executes outside of a <# #> delimited number conversion. 
+*/
+static void sign(FICL_VM *pVM)
+{
+    FICL_STRING *sp = PTRtoSTRING pVM->pad;
+    int i = stackPopINT32(pVM->pStack);
+    if (i < 0)
+        sp->text[sp->count++] = '-';
+    return;
+}
+
+
+/**************************************************************************
+                        t o   N u m b e r
+** to-number CORE ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 )
+** ud2 is the unsigned result of converting the characters within the
+** string specified by c-addr1 u1 into digits, using the number in BASE,
+** and adding each into ud1 after multiplying ud1 by the number in BASE.
+** Conversion continues left-to-right until a character that is not
+** convertible, including any + or -, is encountered or the string is
+** entirely converted. c-addr2 is the location of the first unconverted
+** character or the first character past the end of the string if the string
+** was entirely converted. u2 is the number of unconverted characters in the
+** string. An ambiguous condition exists if ud2 overflows during the
+** conversion. 
+** TO DO: presently does not use ud1 hi cell - use it!
+**************************************************************************/
+static void toNumber(FICL_VM *pVM)
+{
+    UNS32 count     = stackPopUNS32(pVM->pStack);
+    char *cp        = (char *)stackPopPtr(pVM->pStack);
+    UNS64 accum;
+    UNS32 base      = pVM->base;
+    UNS32 ch;
+    UNS32 digit;
+
+    accum = u64Pop(pVM->pStack);
+
+    for (ch = *cp; count > 0; ch = *++cp, count--)
+    {
+        if (ch < '0')
+            break;
+
+        digit = ch - '0';
+
+        if (digit > 9)
+            digit = tolower(ch) - 'a' + 10;
+        /* 
+        ** Note: following test also catches chars between 9 and a
+        ** because 'digit' is unsigned! 
+        */
+        if (digit >= base)
+            break;
+
+        accum = m64Mac(accum, base, digit);
+    }
+
+    u64Push(pVM->pStack, accum);
+    stackPushPtr  (pVM->pStack, cp);
+    stackPushUNS32(pVM->pStack, count);
+
+    return;
+}
+
+
+
+/**************************************************************************
+                        q u i t   &   a b o r t
+** quit CORE   ( -- )  ( R:  i*x -- )
+** Empty the return stack, store zero in SOURCE-ID if it is present, make
+** the user input device the input source, and enter interpretation state. 
+** Do not display a message. Repeat the following: 
+**
+**   Accept a line from the input source into the input buffer, set >IN to
+**   zero, and interpret. 
+**   Display the implementation-defined system prompt if in
+**   interpretation state, all processing has been completed, and no
+**   ambiguous condition exists. 
+**************************************************************************/
+
+static void quit(FICL_VM *pVM)
+{
+    vmThrow(pVM, VM_QUIT);
+    return;
+}
+
+
+static void ficlAbort(FICL_VM *pVM)
+{
+    vmThrow(pVM, VM_ERREXIT);
+    return;
+}
+
+
+/**************************************************************************
+                        a c c e p t
+** accept       CORE ( c-addr +n1 -- +n2 )
+** Receive a string of at most +n1 characters. An ambiguous condition
+** exists if +n1 is zero or greater than 32,767. Display graphic characters
+** as they are received. A program that depends on the presence or absence
+** of non-graphic characters in the string has an environmental dependency.
+** The editing functions, if any, that the system performs in order to
+** construct the string are implementation-defined. 
+**
+** (Although the standard text doesn't say so, I assume that the intent 
+** of 'accept' is to store the string at the address specified on
+** the stack.)
+** Implementation: if there's more text in the TIB, use it. Otherwise
+** throw out for more text. Copy characters up to the max count into the
+** address given, and return the number of actual characters copied.
+**************************************************************************/
+static void accept(FICL_VM *pVM)
+{
+    UNS32 count, len;
+    char *cp;
+    char *pBuf = vmGetInBuf(pVM);
+
+    len = strlen(pBuf);
+    if (len == 0)
+        vmThrow(pVM, VM_RESTART);
+    /* OK - now we have something in the text buffer - use it */
+    count = stackPopUNS32(pVM->pStack);
+    cp    = stackPopPtr(pVM->pStack);
+
+    strncpy(cp, vmGetInBuf(pVM), count);
+    len = (count < len) ? count : len;
+    pBuf += len;
+    vmUpdateTib(pVM, pBuf);
+    stackPushUNS32(pVM->pStack, len);
+
+    return;
+}
+
+
+/**************************************************************************
+                        a l i g n
+** 6.1.0705 ALIGN       CORE ( -- )
+** If the data-space pointer is not aligned, reserve enough space to
+** align it. 
+**************************************************************************/
+static void align(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    IGNORE(pVM);
+    dictAlign(dp);
+    return;
+}
+
+
+/**************************************************************************
+                        a l i g n e d
+** 
+**************************************************************************/
+static void aligned(FICL_VM *pVM)
+{
+    void *addr = stackPopPtr(pVM->pStack);
+    stackPushPtr(pVM->pStack, alignPtr(addr));
+    return;
+}
+
+
+/**************************************************************************
+                        b e g i n   &   f r i e n d s
+** Indefinite loop control structures
+** A.6.1.0760 BEGIN 
+** Typical use: 
+**      : X ... BEGIN ... test UNTIL ;
+** or 
+**      : X ... BEGIN ... test WHILE ... REPEAT ;
+**************************************************************************/
+static void beginCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    markBranch(dp, pVM, beginTag);
+    return;
+}
+
+static void untilCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pIfParen);
+
+    dictAppendCell(dp, LVALUEtoCELL(pIfParen));
+    resolveBackBranch(dp, pVM, beginTag);
+    return;
+}
+
+static void whileCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pIfParen);
+
+    dictAppendCell(dp, LVALUEtoCELL(pIfParen));
+    markBranch(dp, pVM, whileTag);
+    twoSwap(pVM);
+    dictAppendUNS32(dp, 1);
+    return;
+}
+
+static void repeatCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    assert(pBranchParen);
+    dictAppendCell(dp, LVALUEtoCELL(pBranchParen));
+
+    /* expect "begin" branch marker */
+    resolveBackBranch(dp, pVM, beginTag);
+    /* expect "while" branch marker */
+    resolveForwardBranch(dp, pVM, whileTag);
+    return;
+}
+
+
+/**************************************************************************
+                        c h a r   &   f r i e n d s
+** 6.1.0895 CHAR    CORE ( "<spaces>name" -- char )
+** Skip leading space delimiters. Parse name delimited by a space.
+** Put the value of its first character onto the stack. 
+**
+** bracket-char     CORE 
+** Interpretation: Interpretation semantics for this word are undefined.
+** Compilation: ( "<spaces>name" -- )
+** Skip leading space delimiters. Parse name delimited by a space.
+** Append the run-time semantics given below to the current definition. 
+** Run-time: ( -- char )
+** Place char, the value of the first character of name, on the stack. 
+**************************************************************************/
+static void ficlChar(FICL_VM *pVM)
+{
+    STRINGINFO si = vmGetWord(pVM);
+    stackPushUNS32(pVM->pStack, (UNS32)(si.cp[0]));
+
+    return;
+}
+
+static void charCoIm(FICL_VM *pVM)
+{
+    ficlChar(pVM);
+    literalIm(pVM);
+    return;
+}
+
+/**************************************************************************
+                        c h a r P l u s
+** char-plus        CORE ( c-addr1 -- c-addr2 )
+** Add the size in address units of a character to c-addr1, giving c-addr2. 
+**************************************************************************/
+static void charPlus(FICL_VM *pVM)
+{
+    char *cp = stackPopPtr(pVM->pStack);
+    stackPushPtr(pVM->pStack, cp + 1);
+    return;
+}
+
+/**************************************************************************
+                        c h a r s
+** chars        CORE ( n1 -- n2 )
+** n2 is the size in address units of n1 characters. 
+** For most processors, this function can be a no-op. To guarantee
+** portability, we'll multiply by sizeof (char).
+**************************************************************************/
+#if defined (_M_IX86)
+#pragma warning(disable: 4127)
+#endif
+static void ficlChars(FICL_VM *pVM)
+{
+    if (sizeof (char) > 1)
+    {
+        INT32 i = stackPopINT32(pVM->pStack);
+        stackPushINT32(pVM->pStack, i * sizeof (char));
+    }
+    /* otherwise no-op! */
+    return;
+}
+#if defined (_M_IX86)
+#pragma warning(default: 4127)
+#endif
+ 
+
+/**************************************************************************
+                        c o u n t
+** COUNT    CORE ( c-addr1 -- c-addr2 u )
+** Return the character string specification for the counted string stored
+** at c-addr1. c-addr2 is the address of the first character after c-addr1.
+** u is the contents of the character at c-addr1, which is the length in
+** characters of the string at c-addr2. 
+**************************************************************************/
+static void count(FICL_VM *pVM)
+{
+    FICL_STRING *sp = stackPopPtr(pVM->pStack);
+    stackPushPtr(pVM->pStack, sp->text);
+    stackPushUNS32(pVM->pStack, sp->count);
+    return;
+}
+
+/**************************************************************************
+                        e n v i r o n m e n t ?
+** environment-query CORE ( c-addr u -- false | i*x true )
+** c-addr is the address of a character string and u is the string's
+** character count. u may have a value in the range from zero to an
+** implementation-defined maximum which shall not be less than 31. The
+** character string should contain a keyword from 3.2.6 Environmental
+** queries or the optional word sets to be checked for correspondence
+** with an attribute of the present environment. If the system treats the
+** attribute as unknown, the returned flag is false; otherwise, the flag
+** is true and the i*x returned is of the type specified in the table for
+** the attribute queried. 
+**************************************************************************/
+static void environmentQ(FICL_VM *pVM)
+{
+    FICL_DICT *envp = ficlGetEnv();
+    FICL_COUNT  len = (FICL_COUNT)stackPopUNS32(pVM->pStack);
+    char        *cp =  stackPopPtr(pVM->pStack);
+    FICL_WORD  *pFW;
+    STRINGINFO si;
+
+    SI_PSZ(si, cp);
+    pFW = dictLookup(envp, si);
+
+    if (pFW != NULL)
+    {
+        vmExecute(pVM, pFW);
+        stackPushINT32(pVM->pStack, FICL_TRUE);
+    }
+    else
+    {
+        stackPushINT32(pVM->pStack, FICL_FALSE);
+    }
+
+    return;
+}
+
+/**************************************************************************
+                        e v a l u a t e
+** EVALUATE CORE ( i*x c-addr u -- j*x )
+** Save the current input source specification. Store minus-one (-1) in
+** SOURCE-ID if it is present. Make the string described by c-addr and u
+** both the input source and input buffer, set >IN to zero, and interpret.
+** When the parse area is empty, restore the prior input source
+** specification. Other stack effects are due to the words EVALUATEd. 
+**
+** DEFICIENCY: this version does not handle errors or restarts.
+**************************************************************************/
+static void evaluate(FICL_VM *pVM)
+{
+    UNS32 count = stackPopUNS32(pVM->pStack);
+    char *cp    = stackPopPtr(pVM->pStack);
+    CELL id;
+
+    IGNORE(count);
+    id = pVM->sourceID;
+    pVM->sourceID.i = -1;
+    vmPushIP(pVM, &pInterpret);
+    ficlExec(pVM, cp);
+    vmPopIP(pVM);
+    pVM->sourceID = id;
+    return;
+}
+
+
+/**************************************************************************
+                        s t r i n g   q u o t e
+** Intrpreting: get string delimited by a quote from the input stream,
+** copy to a scratch area, and put its count and address on the stack.
+** Compiling: compile code to push the address and count of a string
+** literal, compile the string from the input stream, and align the dict
+** pointer.
+**************************************************************************/
+static void stringQuoteIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    if (pVM->state == INTERPRET)
+    {
+        FICL_STRING *sp = (FICL_STRING *) dp->here;
+        vmGetString(pVM, sp, '\"');
+        stackPushPtr(pVM->pStack, sp->text);
+        stackPushUNS32(pVM->pStack, sp->count);
+    }
+    else    /* COMPILE state */
+    {
+        dictAppendCell(dp, LVALUEtoCELL(pStringLit));
+        dp->here = PTRtoCELL vmGetString(pVM, (FICL_STRING *)dp->here, '\"');
+        dictAlign(dp);
+    }
+
+    return;
+}
+
+/**************************************************************************
+                        t y p e
+** Pop count and char address from stack and print the designated string.
+**************************************************************************/
+static void type(FICL_VM *pVM)
+{
+    UNS32 count = stackPopUNS32(pVM->pStack);
+    char *cp    = stackPopPtr(pVM->pStack);
+
+    /* 
+    ** Since we don't have an output primitive for a counted string
+    ** (oops), make sure the string is null terminated. If not, copy
+    ** and terminate it.
+    */
+    if (cp[count] != '\0')
+    {
+        char *pDest = (char *)ficlGetDict()->here;
+        if (cp != pDest)
+            strncpy(pDest, cp, count);
+
+        pDest[count] = '\0';
+        cp = pDest;
+    }
+
+    vmTextOut(pVM, cp, 0);
+    return;
+}
+
+/**************************************************************************
+                        w o r d
+** word CORE ( char "<chars>ccc<char>" -- c-addr )
+** Skip leading delimiters. Parse characters ccc delimited by char. An
+** ambiguous condition exists if the length of the parsed string is greater
+** than the implementation-defined length of a counted string. 
+** 
+** c-addr is the address of a transient region containing the parsed word
+** as a counted string. If the parse area was empty or contained no
+** characters other than the delimiter, the resulting string has a zero
+** length. A space, not included in the length, follows the string. A
+** program may replace characters within the string. 
+** NOTE! Ficl also NULL-terminates the dest string.
+**************************************************************************/
+static void ficlWord(FICL_VM *pVM)
+{
+    FICL_STRING *sp = (FICL_STRING *)pVM->pad;
+    char      delim = (char)stackPopINT32(pVM->pStack);
+    STRINGINFO   si;
+    
+    si = vmParseString(pVM, delim);
+
+    if (SI_COUNT(si) > nPAD-1)
+        SI_SETLEN(si, nPAD-1);
+
+    sp->count = (FICL_COUNT)SI_COUNT(si);
+    strncpy(sp->text, SI_PTR(si), SI_COUNT(si));
+    strcat(sp->text, " ");
+
+    stackPushPtr(pVM->pStack, sp);
+    return;
+}
+
+
+/**************************************************************************
+                        p a r s e - w o r d
+** ficl   PARSE-WORD  ( <spaces>name -- c-addr u )
+** Skip leading spaces and parse name delimited by a space. c-addr is the
+** address within the input buffer and u is the length of the selected 
+** string. If the parse area is empty, the resulting string has a zero length.
+**************************************************************************/
+static void parseNoCopy(FICL_VM *pVM)
+{
+    STRINGINFO si = vmGetWord0(pVM);
+    stackPushPtr(pVM->pStack, SI_PTR(si));
+    stackPushUNS32(pVM->pStack, SI_COUNT(si));
+    return;
+}
+
+
+/**************************************************************************
+                        p a r s e
+** CORE EXT  ( char "ccc<char>" -- c-addr u )
+** Parse ccc delimited by the delimiter char. 
+** c-addr is the address (within the input buffer) and u is the length of 
+** the parsed string. If the parse area was empty, the resulting string has
+** a zero length. 
+** NOTE! PARSE differs from WORD: it does not skip leading delimiters.
+**************************************************************************/
+static void parse(FICL_VM *pVM)
+{
+    char *pSrc      = vmGetInBuf(pVM);
+    char *cp;
+    UNS32 count;
+    char delim      = (char)stackPopINT32(pVM->pStack);
+
+    cp = pSrc;              /* mark start of text */
+
+    while ((*pSrc != delim) && (*pSrc != '\0'))
+        pSrc++;             /* find next delimiter or end */
+
+    count = pSrc - cp;      /* set length of result */
+
+    if (*pSrc == delim)     /* gobble trailing delimiter */
+        pSrc++;
+
+    vmUpdateTib(pVM, pSrc);
+    stackPushPtr(pVM->pStack, cp);
+    stackPushUNS32(pVM->pStack, count);
+    return;
+}
+
+
+/**************************************************************************
+                        f i l l
+** CORE ( c-addr u char -- )
+** If u is greater than zero, store char in each of u consecutive
+** characters of memory beginning at c-addr. 
+**************************************************************************/
+static void fill(FICL_VM *pVM)
+{
+    char ch  = (char)stackPopINT32(pVM->pStack);
+    UNS32  u = stackPopUNS32(pVM->pStack);
+    char *cp = (char *)stackPopPtr(pVM->pStack);
+
+    while (u > 0)
+    {
+        *cp++ = ch;
+        u--;
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        f i n d
+** FIND CORE ( c-addr -- c-addr 0  |  xt 1  |  xt -1 )
+** Find the definition named in the counted string at c-addr. If the
+** definition is not found, return c-addr and zero. If the definition is
+** found, return its execution token xt. If the definition is immediate,
+** also return one (1), otherwise also return minus-one (-1). For a given
+** string, the values returned by FIND while compiling may differ from
+** those returned while not compiling. 
+**************************************************************************/
+static void find(FICL_VM *pVM)
+{
+    FICL_STRING *sp = stackPopPtr(pVM->pStack);
+    FICL_WORD *pFW;
+    STRINGINFO si;
+
+    SI_PFS(si, sp);
+    pFW = dictLookup(ficlGetDict(), si);
+    if (pFW)
+    {
+        stackPushPtr(pVM->pStack, pFW);
+        stackPushINT32(pVM->pStack, (wordIsImmediate(pFW) ? 1 : -1));
+    }
+    else
+    {
+        stackPushPtr(pVM->pStack, sp);
+        stackPushUNS32(pVM->pStack, 0);
+    }
+    return;
+}
+
+
+/**************************************************************************
+                        f m S l a s h M o d
+** f-m-slash-mod CORE ( d1 n1 -- n2 n3 )
+** Divide d1 by n1, giving the floored quotient n3 and the remainder n2.
+** Input and output stack arguments are signed. An ambiguous condition
+** exists if n1 is zero or if the quotient lies outside the range of a
+** single-cell signed integer. 
+**************************************************************************/
+static void fmSlashMod(FICL_VM *pVM)
+{
+    INT64 d1;
+    INT32 n1;
+    INTQR qr;
+
+    n1    = stackPopINT32(pVM->pStack);
+    d1 = i64Pop(pVM->pStack);
+    qr = m64FlooredDivI(d1, n1);
+    stackPushINT32(pVM->pStack, qr.rem);
+    stackPushINT32(pVM->pStack, qr.quot);
+    return;
+}
+
+
+/**************************************************************************
+                        s m S l a s h R e m
+** s-m-slash-rem CORE ( d1 n1 -- n2 n3 )
+** Divide d1 by n1, giving the symmetric quotient n3 and the remainder n2.
+** Input and output stack arguments are signed. An ambiguous condition
+** exists if n1 is zero or if the quotient lies outside the range of a
+** single-cell signed integer. 
+**************************************************************************/
+static void smSlashRem(FICL_VM *pVM)
+{
+    INT64 d1;
+    INT32 n1;
+    INTQR qr;
+
+    n1    = stackPopINT32(pVM->pStack);
+    d1 = i64Pop(pVM->pStack);
+    qr = m64SymmetricDivI(d1, n1);
+    stackPushINT32(pVM->pStack, qr.rem);
+    stackPushINT32(pVM->pStack, qr.quot);
+    return;
+}
+
+
+static void ficlMod(FICL_VM *pVM)
+{
+    INT64 d1;
+    INT32 n1;
+    INTQR qr;
+
+    n1    = stackPopINT32(pVM->pStack);
+    d1.lo = stackPopINT32(pVM->pStack);
+    i64Extend(d1);
+    qr = m64SymmetricDivI(d1, n1);
+    stackPushINT32(pVM->pStack, qr.rem);
+    return;
+}
+
+
+/**************************************************************************
+                        u m S l a s h M o d
+** u-m-slash-mod CORE ( ud u1 -- u2 u3 )
+** Divide ud by u1, giving the quotient u3 and the remainder u2.
+** All values and arithmetic are unsigned. An ambiguous condition
+** exists if u1 is zero or if the quotient lies outside the range of a
+** single-cell unsigned integer. 
+*************************************************************************/
+static void umSlashMod(FICL_VM *pVM)
+{
+    UNS64 ud;
+    UNS32 u1;
+    UNSQR qr;
+
+    u1    = stackPopUNS32(pVM->pStack);
+    ud    = u64Pop(pVM->pStack);
+    qr    = ficlLongDiv(ud, u1);
+    stackPushUNS32(pVM->pStack, qr.rem);
+    stackPushUNS32(pVM->pStack, qr.quot);
+    return;
+}
+
+
+/**************************************************************************
+                        l s h i f t
+** l-shift CORE ( x1 u -- x2 )
+** Perform a logical left shift of u bit-places on x1, giving x2.
+** Put zeroes into the least significant bits vacated by the shift.
+** An ambiguous condition exists if u is greater than or equal to the
+** number of bits in a cell. 
+**
+** r-shift CORE ( x1 u -- x2 )
+** Perform a logical right shift of u bit-places on x1, giving x2.
+** Put zeroes into the most significant bits vacated by the shift. An
+** ambiguous condition exists if u is greater than or equal to the
+** number of bits in a cell. 
+**************************************************************************/
+static void lshift(FICL_VM *pVM)
+{
+    UNS32 nBits = stackPopUNS32(pVM->pStack);
+    UNS32 x1    = stackPopUNS32(pVM->pStack);
+
+    stackPushUNS32(pVM->pStack, x1 << nBits);
+    return;
+}
+
+
+static void rshift(FICL_VM *pVM)
+{
+    UNS32 nBits = stackPopUNS32(pVM->pStack);
+    UNS32 x1    = stackPopUNS32(pVM->pStack);
+
+    stackPushUNS32(pVM->pStack, x1 >> nBits);
+    return;
+}
+
+
+/**************************************************************************
+                        m S t a r
+** m-star CORE ( n1 n2 -- d )
+** d is the signed product of n1 times n2. 
+**************************************************************************/
+static void mStar(FICL_VM *pVM)
+{
+    INT32 n2 = stackPopINT32(pVM->pStack);
+    INT32 n1 = stackPopINT32(pVM->pStack);
+    INT64 d;
+    
+    d = m64MulI(n1, n2);
+    i64Push(pVM->pStack, d);
+    return;
+}
+
+
+static void umStar(FICL_VM *pVM)
+{
+    UNS32 u2 = stackPopUNS32(pVM->pStack);
+    UNS32 u1 = stackPopUNS32(pVM->pStack);
+    UNS64 ud;
+    
+    ud = ficlLongMul(u1, u2);
+    u64Push(pVM->pStack, ud);
+    return;
+}
+
+
+/**************************************************************************
+                        m a x   &   m i n
+** 
+**************************************************************************/
+static void ficlMax(FICL_VM *pVM)
+{
+    INT32 n2 = stackPopINT32(pVM->pStack);
+    INT32 n1 = stackPopINT32(pVM->pStack);
+
+    stackPushINT32(pVM->pStack, (n1 > n2) ? n1 : n2);
+    return;
+}
+
+static void ficlMin(FICL_VM *pVM)
+{
+    INT32 n2 = stackPopINT32(pVM->pStack);
+    INT32 n1 = stackPopINT32(pVM->pStack);
+
+    stackPushINT32(pVM->pStack, (n1 < n2) ? n1 : n2);
+    return;
+}
+
+
+/**************************************************************************
+                        m o v e
+** CORE ( addr1 addr2 u -- )
+** If u is greater than zero, copy the contents of u consecutive address
+** units at addr1 to the u consecutive address units at addr2. After MOVE
+** completes, the u consecutive address units at addr2 contain exactly
+** what the u consecutive address units at addr1 contained before the move. 
+** NOTE! This implementation assumes that a char is the same size as
+**       an address unit.
+**************************************************************************/
+static void move(FICL_VM *pVM)
+{
+    UNS32 u     = stackPopUNS32(pVM->pStack);
+    char *addr2 = stackPopPtr(pVM->pStack);
+    char *addr1 = stackPopPtr(pVM->pStack);
+
+    if (u == 0) 
+        return;
+    /*
+    ** Do the copy carefully, so as to be
+    ** correct even if the two ranges overlap
+    */
+    if (addr1 >= addr2)
+    {
+        for (; u > 0; u--)
+            *addr2++ = *addr1++;
+    }
+    else
+    {
+        addr2 += u-1;
+        addr1 += u-1;
+        for (; u > 0; u--)
+            *addr2-- = *addr1--;
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        r e c u r s e
+** 
+**************************************************************************/
+static void recurseCoIm(FICL_VM *pVM)
+{
+    FICL_DICT *pDict = ficlGetDict();
+
+    IGNORE(pVM);
+    dictAppendCell(pDict, LVALUEtoCELL(pDict->smudge));
+    return;
+}
+
+
+/**************************************************************************
+                        s t o d
+** s-to-d CORE ( n -- d )
+** Convert the number n to the double-cell number d with the same
+** numerical value. 
+**************************************************************************/
+static void sToD(FICL_VM *pVM)
+{
+    INT32 s = stackPopINT32(pVM->pStack);
+
+    /* sign extend to 64 bits.. */
+    stackPushINT32(pVM->pStack, s);
+    stackPushINT32(pVM->pStack, (s < 0) ? -1 : 0);
+    return;
+}
+
+
+/**************************************************************************
+                        s o u r c e
+** CORE ( -- c-addr u )
+** c-addr is the address of, and u is the number of characters in, the
+** input buffer. 
+**************************************************************************/
+static void source(FICL_VM *pVM)
+{
+    stackPushPtr(pVM->pStack, pVM->tib.cp);
+    stackPushINT32(pVM->pStack, strlen(pVM->tib.cp));
+    return;
+}
+
+
+/**************************************************************************
+                        v e r s i o n
+** non-standard...
+**************************************************************************/
+static void ficlVersion(FICL_VM *pVM)
+{
+    vmTextOut(pVM, "ficl Version " FICL_VER, 1);
+    return;
+}
+
+
+/**************************************************************************
+                        t o I n
+** to-in CORE
+**************************************************************************/
+static void toIn(FICL_VM *pVM)
+{
+    stackPushPtr(pVM->pStack, &pVM->tib.index);
+    return;
+}
+
+
+/**************************************************************************
+                        d e f i n i t i o n s
+** SEARCH ( -- )
+** Make the compilation word list the same as the first word list in the
+** search order. Specifies that the names of subsequent definitions will
+** be placed in the compilation word list. Subsequent changes in the search
+** order will not affect the compilation word list. 
+**************************************************************************/
+static void definitions(FICL_VM *pVM)
+{
+    FICL_DICT *pDict = ficlGetDict();
+
+    assert(pDict);
+    if (pDict->nLists < 1)
+    {
+        vmThrowErr(pVM, "DEFINITIONS error - empty search order");
+    }
+
+    pDict->pCompile = pDict->pSearch[pDict->nLists-1];
+    return;
+}
+
+
+/**************************************************************************
+                        f o r t h - w o r d l i s t
+** SEARCH ( -- wid )
+** Return wid, the identifier of the word list that includes all standard
+** words provided by the implementation. This word list is initially the
+** compilation word list and is part of the initial search order. 
+**************************************************************************/
+static void forthWordlist(FICL_VM *pVM)
+{
+    FICL_HASH *pHash = ficlGetDict()->pForthWords;
+    stackPushPtr(pVM->pStack, pHash);
+    return;
+}
+
+
+/**************************************************************************
+                        g e t - c u r r e n t
+** SEARCH ( -- wid )
+** Return wid, the identifier of the compilation word list. 
+**************************************************************************/
+static void getCurrent(FICL_VM *pVM)
+{
+    ficlLockDictionary(TRUE);
+    stackPushPtr(pVM->pStack, ficlGetDict()->pCompile);
+    ficlLockDictionary(FALSE);
+    return;
+}
+
+
+/**************************************************************************
+                        g e t - o r d e r
+** SEARCH ( -- widn ... wid1 n )
+** Returns the number of word lists n in the search order and the word list
+** identifiers widn ... wid1 identifying these word lists. wid1 identifies
+** the word list that is searched first, and widn the word list that is
+** searched last. The search order is unaffected.
+**************************************************************************/
+static void getOrder(FICL_VM *pVM)
+{
+    FICL_DICT *pDict = ficlGetDict();
+    int nLists = pDict->nLists;
+    int i;
+
+    ficlLockDictionary(TRUE);
+    for (i = 0; i < nLists; i++)
+    {
+        stackPushPtr(pVM->pStack, pDict->pSearch[i]);
+    }
+
+    stackPushUNS32(pVM->pStack, nLists);
+    ficlLockDictionary(FALSE);
+    return;
+}
+
+
+/**************************************************************************
+                        s e a r c h - w o r d l i s t
+** SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 )
+** Find the definition identified by the string c-addr u in the word list
+** identified by wid. If the definition is not found, return zero. If the
+** definition is found, return its execution token xt and one (1) if the
+** definition is immediate, minus-one (-1) otherwise. 
+**************************************************************************/
+static void searchWordlist(FICL_VM *pVM)
+{
+    STRINGINFO si;
+    UNS16 hashCode;
+    FICL_WORD *pFW;
+    FICL_HASH *pHash = stackPopPtr(pVM->pStack);
+
+    si.count         = (FICL_COUNT)stackPopUNS32(pVM->pStack);
+    si.cp            = stackPopPtr(pVM->pStack);
+    hashCode         = hashHashCode(si);
+
+    ficlLockDictionary(TRUE);
+    pFW = hashLookup(pHash, si, hashCode);
+    ficlLockDictionary(FALSE);
+
+    if (pFW)
+    {
+        stackPushPtr(pVM->pStack, pFW);
+        stackPushINT32(pVM->pStack, (wordIsImmediate(pFW) ? 1 : -1));
+    }
+    else
+    {
+        stackPushUNS32(pVM->pStack, 0);
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        s e t - c u r r e n t
+** SEARCH ( wid -- )
+** Set the compilation word list to the word list identified by wid. 
+**************************************************************************/
+static void setCurrent(FICL_VM *pVM)
+{
+    FICL_HASH *pHash = stackPopPtr(pVM->pStack);
+    FICL_DICT *pDict = ficlGetDict();
+    ficlLockDictionary(TRUE);
+    pDict->pCompile = pHash;
+    ficlLockDictionary(FALSE);
+    return;
+}
+
+
+/**************************************************************************
+                        s e t - o r d e r
+** SEARCH ( widn ... wid1 n -- )
+** Set the search order to the word lists identified by widn ... wid1.
+** Subsequently, word list wid1 will be searched first, and word list
+** widn searched last. If n is zero, empty the search order. If n is minus
+** one, set the search order to the implementation-defined minimum
+** search order. The minimum search order shall include the words
+** FORTH-WORDLIST and SET-ORDER. A system shall allow n to
+** be at least eight.
+**************************************************************************/
+static void setOrder(FICL_VM *pVM)
+{
+    int i;
+    int nLists = stackPopINT32(pVM->pStack);
+    FICL_DICT *dp = ficlGetDict();
+
+    if (nLists > FICL_DEFAULT_VOCS)
+    {
+        vmThrowErr(pVM, "set-order error: list would be too large");
+    }
+
+    ficlLockDictionary(TRUE);
+
+    if (nLists >= 0)
+    {
+        dp->nLists = nLists;
+        for (i = nLists-1; i >= 0; --i)
+        {
+            dp->pSearch[i] = stackPopPtr(pVM->pStack);
+        }
+    }
+    else
+    {
+        dictResetSearchOrder(dp);
+    }
+
+    ficlLockDictionary(FALSE);
+    return;
+}
+
+
+/**************************************************************************
+                        w o r d l i s t
+** SEARCH ( -- wid )
+** Create a new empty word list, returning its word list identifier wid.
+** The new word list may be returned from a pool of preallocated word
+** lists or may be dynamically allocated in data space. A system shall
+** allow the creation of at least 8 new word lists in addition to any
+** provided as part of the system. 
+** Notes: 
+** 1. ficl creates a new single-list hash in the dictionary and returns
+**    its address.
+** 2. ficl-wordlist takes an arg off the stack indicating the number of
+**    hash entries in the wordlist. Ficl 2.02 and later define WORDLIST as
+**    : wordlist 1 ficl-wordlist ;
+**************************************************************************/
+static void wordlist(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    FICL_HASH *pHash;
+    UNS32 nBuckets;
+    
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 1);
+#endif
+    nBuckets = stackPopUNS32(pVM->pStack);
+
+    dictAlign(dp);
+    pHash    = (FICL_HASH *)dp->here;
+    dictAllot(dp, sizeof (FICL_HASH) 
+        + (nBuckets-1) * sizeof (FICL_WORD *));
+
+    pHash->size = nBuckets;
+    hashReset(pHash);
+
+    stackPushPtr(pVM->pStack, pHash);
+    return;
+}
+
+
+/**************************************************************************
+                        S E A R C H >
+** ficl  ( -- wid )
+** Pop wid off the search order. Error if the search order is empty
+**************************************************************************/
+static void searchPop(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    int nLists;
+
+    ficlLockDictionary(TRUE);
+    nLists = dp->nLists;
+    if (nLists == 0)
+    {
+        vmThrowErr(pVM, "search> error: empty search order");
+    }
+    stackPushPtr(pVM->pStack, dp->pSearch[--dp->nLists]);
+    ficlLockDictionary(FALSE);
+    return;
+}
+
+
+/**************************************************************************
+                        > S E A R C H
+** ficl  ( wid -- )
+** Push wid onto the search order. Error if the search order is full.
+**************************************************************************/
+static void searchPush(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+
+    ficlLockDictionary(TRUE);
+    if (dp->nLists > FICL_DEFAULT_VOCS)
+    {
+        vmThrowErr(pVM, ">search error: search order overflow");
+    }
+    dp->pSearch[dp->nLists++] = stackPopPtr(pVM->pStack);
+    ficlLockDictionary(FALSE);
+    return;
+}
+
+
+/**************************************************************************
+                        c o l o n N o N a m e
+** CORE EXT ( C:  -- colon-sys )  ( S:  -- xt )
+** Create an unnamed colon definition and push its address.
+** Change state to compile.
+**************************************************************************/
+static void colonNoName(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    FICL_WORD *pFW;
+    STRINGINFO si;
+
+    SI_SETLEN(si, 0);
+    SI_SETPTR(si, NULL);
+
+    pVM->state = COMPILE;
+    pFW = dictAppendWord2(dp, si, colonParen, FW_DEFAULT | FW_SMUDGE);
+    stackPushPtr(pVM->pStack, pFW);
+    markControlTag(pVM, colonTag);
+    return;
+}
+
+
+/**************************************************************************
+                        u s e r   V a r i a b l e
+** user  ( u -- )  "<spaces>name"  
+** Get a name from the input stream and create a user variable
+** with the name and the index supplied. The run-time effect
+** of a user variable is to push the address of the indexed cell
+** in the running vm's user array. 
+**
+** User variables are vm local cells. Each vm has an array of
+** FICL_USER_CELLS of them when FICL_WANT_USER is nonzero.
+** Ficl's user facility is implemented with two primitives,
+** "user" and "(user)", a variable ("nUser") (in softcore.c) that 
+** holds the index of the next free user cell, and a redefinition
+** (also in softcore) of "user" that defines a user word and increments
+** nUser.
+**************************************************************************/
+#if FICL_WANT_USER
+static void userParen(FICL_VM *pVM)
+{
+    INT32 i = pVM->runningWord->param[0].i;
+    stackPushPtr(pVM->pStack, &pVM->user[i]);
+    return;
+}
+
+
+static void userVariable(FICL_VM *pVM)
+{
+    FICL_DICT *dp = ficlGetDict();
+    STRINGINFO si = vmGetWord(pVM);
+    CELL c;
+
+    c = stackPop(pVM->pStack);
+    if (c.i >= FICL_USER_CELLS)
+    {
+        vmThrowErr(pVM, "Error - out of user space");
+    }
+
+    dictAppendWord2(dp, si, userParen, FW_DEFAULT);
+    dictAppendCell(dp, c);
+    return;
+}
+#endif
+
+
+/**************************************************************************
+                        t o V a l u e
+** CORE EXT 
+** Interpretation: ( x "<spaces>name" -- )
+** Skip leading spaces and parse name delimited by a space. Store x in 
+** name. An ambiguous condition exists if name was not defined by VALUE. 
+** NOTE: In ficl, VALUE is an alias of CONSTANT
+**************************************************************************/
+static void toValue(FICL_VM *pVM)
+{
+    STRINGINFO si = vmGetWord(pVM);
+    FICL_DICT *dp = ficlGetDict();
+    FICL_WORD *pFW;
+
+#if FICL_WANT_LOCALS
+    FICL_DICT *pLoc = ficlGetLoc();
+    if ((nLocals > 0) && (pVM->state == COMPILE))
+    {
+        pFW = dictLookup(pLoc, si);
+        if (pFW)
+        {
+            dictAppendCell(dp, LVALUEtoCELL(pToLocalParen));
+            dictAppendCell(dp, LVALUEtoCELL(pFW->param[0]));
+            return;
+        }
+    }
+#endif
+
+    assert(pStore);
+
+    pFW = dictLookup(dp, si);
+    if (!pFW)
+    {
+        int i = SI_COUNT(si);
+        vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
+    }
+
+    if (pVM->state == INTERPRET)
+        pFW->param[0] = stackPop(pVM->pStack);
+    else        /* compile code to store to word's param */
+    {
+        stackPushPtr(pVM->pStack, &pFW->param[0]);
+        literalIm(pVM);
+        dictAppendCell(dp, LVALUEtoCELL(pStore));
+    }
+    return;
+}
+
+
+#if FICL_WANT_LOCALS
+/**************************************************************************
+                        l i n k P a r e n
+** ( -- )
+** Link a frame on the return stack, reserving nCells of space for
+** locals - the value of nCells is the next cell in the instruction
+** stream.
+**************************************************************************/
+static void linkParen(FICL_VM *pVM)
+{
+    INT32 nLink = *(INT32 *)(pVM->ip);
+    vmBranchRelative(pVM, 1);
+    stackLink(pVM->rStack, nLink);
+    return;
+}
+
+
+static void unlinkParen(FICL_VM *pVM)
+{
+    stackUnlink(pVM->rStack);
+    return;
+}
+
+
+/**************************************************************************
+                        d o L o c a l I m
+** Immediate - cfa of a local while compiling - when executed, compiles
+** code to fetch the value of a local given the local's index in the
+** word's pfa
+**************************************************************************/
+static void getLocalParen(FICL_VM *pVM)
+{
+    INT32 nLocal = *(INT32 *)(pVM->ip++);
+    stackPush(pVM->pStack, pVM->rStack->pFrame[nLocal]);
+    return;
+}
+
+
+static void toLocalParen(FICL_VM *pVM)
+{
+    INT32 nLocal = *(INT32 *)(pVM->ip++);
+    pVM->rStack->pFrame[nLocal] = stackPop(pVM->pStack);
+    return;
+}
+
+
+static void getLocal0(FICL_VM *pVM)
+{
+    stackPush(pVM->pStack, pVM->rStack->pFrame[0]);
+    return;
+}
+
+
+static void toLocal0(FICL_VM *pVM)
+{
+    pVM->rStack->pFrame[0] = stackPop(pVM->pStack);
+    return;
+}
+
+
+static void getLocal1(FICL_VM *pVM)
+{
+    stackPush(pVM->pStack, pVM->rStack->pFrame[1]);
+    return;
+}
+
+
+static void toLocal1(FICL_VM *pVM)
+{
+    pVM->rStack->pFrame[1] = stackPop(pVM->pStack);
+    return;
+}
+
+
+/*
+** Each local is recorded in a private locals dictionary as a 
+** word that does doLocalIm at runtime. DoLocalIm compiles code
+** into the client definition to fetch the value of the 
+** corresponding local variable from the return stack.
+** The private dictionary gets initialized at the end of each block
+** that uses locals (in ; and does> for example).
+*/
+static void doLocalIm(FICL_VM *pVM)
+{
+    FICL_DICT *pDict = ficlGetDict();
+    int nLocal = pVM->runningWord->param[0].i;
+
+    if (pVM->state == INTERPRET)
+    {
+        stackPush(pVM->pStack, pVM->rStack->pFrame[nLocal]);
+    }
+    else
+    {
+        
+        if (nLocal == 0)
+        {
+            dictAppendCell(pDict, LVALUEtoCELL(pGetLocal0));
+        }
+        else if (nLocal == 1)
+        {
+            dictAppendCell(pDict, LVALUEtoCELL(pGetLocal1));
+        }
+        else
+        {
+            dictAppendCell(pDict, LVALUEtoCELL(pGetLocalParen));
+            dictAppendCell(pDict, LVALUEtoCELL(nLocal));
+        }
+    }
+    return;
+}
+
+
+/**************************************************************************
+                        l o c a l P a r e n
+** paren-local-paren LOCAL 
+** Interpretation: Interpretation semantics for this word are undefined.
+** Execution: ( c-addr u -- )
+** When executed during compilation, (LOCAL) passes a message to the 
+** system that has one of two meanings. If u is non-zero,
+** the message identifies a new local whose definition name is given by
+** the string of characters identified by c-addr u. If u is zero,
+** the message is last local and c-addr has no significance. 
+**
+** The result of executing (LOCAL) during compilation of a definition is
+** to create a set of named local identifiers, each of which is
+** a definition name, that only have execution semantics within the scope
+** of that definition's source. 
+**
+** local Execution: ( -- x )
+**
+** Push the local's value, x, onto the stack. The local's value is
+** initialized as described in 13.3.3 Processing locals and may be
+** changed by preceding the local's name with TO. An ambiguous condition
+** exists when local is executed while in interpretation state. 
+**************************************************************************/
+static void localParen(FICL_VM *pVM)
+{
+    static CELL *pMark = NULL;
+    FICL_DICT *pDict = ficlGetDict();
+    STRINGINFO si;
+    SI_SETLEN(si, stackPopUNS32(pVM->pStack));
+    SI_SETPTR(si, (char *)stackPopPtr(pVM->pStack));
+
+    if (SI_COUNT(si) > 0)
+    {       /* add a local to the dict and update nLocals */
+        FICL_DICT *pLoc = ficlGetLoc();
+        if (nLocals >= FICL_MAX_LOCALS)
+        {
+            vmThrowErr(pVM, "Error: out of local space");
+        }
+
+        dictAppendWord2(pLoc, si, doLocalIm, FW_COMPIMMED);
+        dictAppendCell(pLoc,  LVALUEtoCELL(nLocals));
+
+        if (nLocals == 0)
+        {   /* compile code to create a local stack frame */
+            dictAppendCell(pDict, LVALUEtoCELL(pLinkParen));
+            /* save location in dictionary for #locals */
+            pMark = pDict->here;
+            dictAppendCell(pDict, LVALUEtoCELL(nLocals));
+            /* compile code to initialize first local */
+            dictAppendCell(pDict, LVALUEtoCELL(pToLocal0));
+        }
+        else if (nLocals == 1)
+        {
+            dictAppendCell(pDict, LVALUEtoCELL(pToLocal1));
+        }
+        else
+        {
+            dictAppendCell(pDict, LVALUEtoCELL(pToLocalParen));
+            dictAppendCell(pDict, LVALUEtoCELL(nLocals));
+        }
+
+        nLocals++;
+    }
+    else if (nLocals > 0)
+    {       /* write nLocals to (link) param area in dictionary */
+        *(INT32 *)pMark = nLocals;
+    }
+
+    return;
+}
+
+
+#endif
+/**************************************************************************
+                        setParentWid
+** FICL
+** setparentwid   ( parent-wid wid -- )
+** Set WID's link field to the parent-wid. search-wordlist will 
+** iterate through all the links when finding words in the child wid.
+**************************************************************************/
+static void setParentWid(FICL_VM *pVM)
+{
+    FICL_HASH *parent, *child;
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 2, 0);
+#endif
+    child  = (FICL_HASH *)stackPopPtr(pVM->pStack);
+    parent = (FICL_HASH *)stackPopPtr(pVM->pStack);
+
+    child->link = parent;
+    return;
+}
+
+
+/**************************************************************************
+                        s e e 
+** TOOLS ( "<spaces>name" -- )
+** Display a human-readable representation of the named word's definition.
+** The source of the representation (object-code decompilation, source
+** block, etc.) and the particular form of the display is implementation
+** defined. 
+** NOTE: these funcs come late in the file because they reference all
+** of the word-builder funcs without declaring them again. Call me lazy.
+**************************************************************************/
+/*
+** isAFiclWord
+** Vet a candidate pointer carefully to make sure
+** it's not some chunk o' inline data...
+** It has to have a name, and it has to look
+** like it's in the dictionary address range.
+** NOTE: this excludes :noname words!
+*/
+static int isAFiclWord(FICL_WORD *pFW)
+{
+    void *pv = (void *)pFW;
+    FICL_DICT *pd  = ficlGetDict();
+
+    if (!dictIncludes(pd, pFW))
+       return 0;
+
+    if (!dictIncludes(pd, pFW->name))
+        return 0;
+
+    return ((pFW->nName > 0) && (pFW->name[pFW->nName] == '\0'));
+}
+
+/*
+** seeColon (for proctologists only)
+** Walks a colon definition, decompiling
+** on the fly. Knows about primitive control structures.
+*/
+static void seeColon(FICL_VM *pVM, CELL *pc)
+{
+    for (; pc->p != pSemiParen; pc++)
+    {
+        FICL_WORD *pFW = (FICL_WORD *)(pc->p);
+
+        if (isAFiclWord(pFW))
+        {
+            if      (pFW->code == literalParen)
+            {
+                CELL v = *++pc;
+                if (isAFiclWord(v.p))
+                {
+                    FICL_WORD *pLit = (FICL_WORD *)v.p;
+                    sprintf(pVM->pad, "    literal %.*s (%#lx)", 
+                        pLit->nName, pLit->name, v.u);
+                }
+                else
+                    sprintf(pVM->pad, "    literal %ld (%#lx)", v.i, v.u);
+            }
+            else if (pFW->code == stringLit) 
+            {
+                FICL_STRING *sp = (FICL_STRING *)(void *)++pc;
+                pc = (CELL *)alignPtr(sp->text + sp->count + 1) - 1;
+                sprintf(pVM->pad, "    s\" %.*s\"", sp->count, sp->text);
+            }
+            else if (pFW->code == ifParen) 
+            {
+                CELL c = *++pc;
+                if (c.i > 0)
+                    sprintf(pVM->pad, "    if / while (branch rel %ld)", c.i);
+                else
+                    sprintf(pVM->pad, "    until (branch rel %ld)", c.i);
+            }
+            else if (pFW->code == branchParen) 
+            {
+                CELL c = *++pc;
+                if (c.i > 0)
+                    sprintf(pVM->pad, "    else (branch rel %ld)", c.i);
+                else
+                    sprintf(pVM->pad, "    repeat (branch rel %ld)", c.i);
+            }
+            else if (pFW->code == qDoParen) 
+            {
+                CELL c = *++pc;
+                sprintf(pVM->pad, "    ?do (leave abs %#lx)", c.u);
+            }
+            else if (pFW->code == doParen) 
+            {
+                CELL c = *++pc;
+                sprintf(pVM->pad, "    do (leave abs %#lx)", c.u);
+            }
+            else if (pFW->code == loopParen) 
+            {
+                CELL c = *++pc;
+                sprintf(pVM->pad, "    loop (branch rel %#ld)", c.i);
+            }
+            else if (pFW->code == plusLoopParen) 
+            {
+                CELL c = *++pc;
+                sprintf(pVM->pad, "    +loop (branch rel %#ld)", c.i);
+            }
+            else /* default: print word's name */
+            {
+                sprintf(pVM->pad, "    %.*s", pFW->nName, pFW->name);
+            }
+ 
+            vmTextOut(pVM, pVM->pad, 1);
+        }
+        else /* probably not a word - punt and print value */
+        {
+            sprintf(pVM->pad, "    %ld (%#lx)", pc->i, pc->u);
+            vmTextOut(pVM, pVM->pad, 1);
+        }
+    }
+
+    vmTextOut(pVM, ";", 1);
+}
+
+/*
+** Here's the outer part of the decompiler. It's 
+** just a big nested conditional that checks the
+** CFA of the word to decompile for each kind of
+** known word-builder code, and tries to do 
+** something appropriate. If the CFA is not recognized,
+** just indicate that it is a primitive.
+*/
+static void see(FICL_VM *pVM)
+{
+    FICL_DICT *pd  = ficlGetDict();
+    FICL_WORD *pFW;
+
+    tick(pVM);
+    pFW = (FICL_WORD *)stackPopPtr(pVM->pStack);
+
+    if (pFW->code == colonParen) 
+    {
+        sprintf(pVM->pad, ": %.*s", pFW->nName, pFW->name);
+        vmTextOut(pVM, pVM->pad, 1);
+        seeColon(pVM, pFW->param);
+    }
+    else if (pFW->code == doDoes)
+    {
+        vmTextOut(pVM, "does>", 1);
+        seeColon(pVM, (CELL *)pFW->param->p);
+    }
+    else if (pFW->code ==  createParen)
+    {
+        vmTextOut(pVM, "create", 1);
+    }
+    else if (pFW->code == variableParen)
+    {
+        sprintf(pVM->pad, "variable = %ld (%#lx)", 
+            pFW->param->i, pFW->param->u);
+        vmTextOut(pVM, pVM->pad, 1);
+    }
+    else if (pFW->code == userParen)
+    {
+        sprintf(pVM->pad, "user variable %ld (%#lx)", 
+            pFW->param->i, pFW->param->u);
+        vmTextOut(pVM, pVM->pad, 1);
+    }
+    else if (pFW->code == constantParen)
+    {
+        sprintf(pVM->pad, "constant = %ld (%#lx)", 
+            pFW->param->i, pFW->param->u);
+        vmTextOut(pVM, pVM->pad, 1);
+    }
+    else 
+    {
+        vmTextOut(pVM, "primitive", 1);
+    }
+
+    if (pFW->flags & FW_IMMEDIATE)
+    {
+        vmTextOut(pVM, "immediate", 1);
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        c o m p a r e 
+** STRING ( c-addr1 u1 c-addr2 u2 -- n )
+** Compare the string specified by c-addr1 u1 to the string specified by
+** c-addr2 u2. The strings are compared, beginning at the given addresses,
+** character by character, up to the length of the shorter string or until a
+** difference is found. If the two strings are identical, n is zero. If the two
+** strings are identical up to the length of the shorter string, n is minus-one
+** (-1) if u1 is less than u2 and one (1) otherwise. If the two strings are not
+** identical up to the length of the shorter string, n is minus-one (-1) if the 
+** first non-matching character in the string specified by c-addr1 u1 has a
+** lesser numeric value than the corresponding character in the string specified
+** by c-addr2 u2 and one (1) otherwise. 
+**************************************************************************/
+static void compareString(FICL_VM *pVM)
+{
+    char *cp1, *cp2;
+    UNS32 u1, u2, uMin;
+    int n = 0;
+
+    vmCheckStack(pVM, 4, 1);
+    u2  = stackPopUNS32(pVM->pStack);
+    cp2 = (char *)stackPopPtr(pVM->pStack);
+    u1  = stackPopUNS32(pVM->pStack);
+    cp1 = (char *)stackPopPtr(pVM->pStack);
+
+    uMin = (u1 < u2)? u1 : u2;
+    for ( ; (uMin > 0) && (n == 0); uMin--)
+    {
+        n = (int)(*cp1++ - *cp2++);
+    }
+
+    if (n == 0)
+        n = (int)(u1 - u2);
+
+    if (n < 0) 
+        n = -1;
+    else if (n > 0)
+        n = 1;
+
+    stackPushINT32(pVM->pStack, n);
+    return;
+}
+
+
+/**************************************************************************
+                        r e f i l l
+** CORE EXT   ( -- flag )
+** Attempt to fill the input buffer from the input source, returning a true
+** flag if successful. 
+** When the input source is the user input device, attempt to receive input
+** into the terminal input buffer. If successful, make the result the input
+** buffer, set >IN to zero, and return true. Receipt of a line containing no
+** characters is considered successful. If there is no input available from
+** the current input source, return false. 
+** When the input source is a string from EVALUATE, return false and
+** perform no other action. 
+**************************************************************************/
+static void refill(FICL_VM *pVM)
+{
+    INT32 ret = (pVM->sourceID.i == -1) ? FICL_FALSE : FICL_TRUE;
+    stackPushINT32(pVM->pStack, ret);
+    if (ret)
+        vmThrow(pVM, VM_OUTOFTEXT);
+    return;
+}
+
+
+/**************************************************************************
+                        f o r g e t
+** TOOLS EXT  ( "<spaces>name" -- )
+** Skip leading space delimiters. Parse name delimited by a space.
+** Find name, then delete name from the dictionary along with all
+** words added to the dictionary after name. An ambiguous
+** condition exists if name cannot be found. 
+** 
+** If the Search-Order word set is present, FORGET searches the
+** compilation word list. An ambiguous condition exists if the
+** compilation word list is deleted. 
+**************************************************************************/
+static void forgetWid(FICL_VM *pVM)
+{
+    FICL_DICT *pDict = ficlGetDict();
+    FICL_HASH *pHash;
+
+    pHash = (FICL_HASH *)stackPopPtr(pVM->pStack);
+    hashForget(pHash, pDict->here);
+
+    return;
+}
+
+
+static void forget(FICL_VM *pVM)
+{
+    void *where;
+    FICL_DICT *pDict = ficlGetDict();
+    FICL_HASH *pHash = pDict->pCompile;
+
+    tick(pVM);
+    where = ((FICL_WORD *)stackPopPtr(pVM->pStack))->name;
+    hashForget(pHash, where);
+    pDict->here = PTRtoCELL where;
+
+    return;
+}
+
+
+#if 0
+/**************************************************************************
+                        
+** 
+**************************************************************************/
+static void funcname(FICL_VM *pVM)
+{
+    IGNORE(pVM);
+    return;
+}
+
+
+#endif
+/**************************************************************************
+                        f i c l C o m p i l e C o r e
+** Builds the primitive wordset and the environment-query namespace.
+**************************************************************************/
+
+void ficlCompileCore(FICL_DICT *dp)
+{
+    assert (dp);
+
+    /*
+    ** CORE word set
+    ** see softcore.c for definitions of: abs bl space spaces abort"
+    */
+    pStore =
+    dictAppendWord(dp, "!",         store,          FW_DEFAULT);
+    dictAppendWord(dp, "#",         numberSign,     FW_DEFAULT);
+    dictAppendWord(dp, "#>",        numberSignGreater,FW_DEFAULT);
+    dictAppendWord(dp, "#s",        numberSignS,    FW_DEFAULT);
+    dictAppendWord(dp, "\'",        tick,           FW_DEFAULT);
+    dictAppendWord(dp, "(",         commentHang,    FW_IMMEDIATE);
+    dictAppendWord(dp, "*",         mul,            FW_DEFAULT);
+    dictAppendWord(dp, "*/",        mulDiv,         FW_DEFAULT);
+    dictAppendWord(dp, "*/mod",     mulDivRem,      FW_DEFAULT);
+    dictAppendWord(dp, "+",         add,            FW_DEFAULT);
+    dictAppendWord(dp, "+!",        plusStore,      FW_DEFAULT);
+    dictAppendWord(dp, "+loop",     plusLoopCoIm,   FW_COMPIMMED);
+    pComma =
+    dictAppendWord(dp, ",",         comma,          FW_DEFAULT);
+    dictAppendWord(dp, "-",         sub,            FW_DEFAULT);
+    dictAppendWord(dp, ".",         displayCell,    FW_DEFAULT);
+    dictAppendWord(dp, ".\"",       dotQuoteCoIm,   FW_COMPIMMED);
+    dictAppendWord(dp, "/",         ficlDiv,        FW_DEFAULT);
+    dictAppendWord(dp, "/mod",      slashMod,       FW_DEFAULT);
+    dictAppendWord(dp, "0<",        zeroLess,       FW_DEFAULT);
+    dictAppendWord(dp, "0=",        zeroEquals,     FW_DEFAULT);
+    dictAppendWord(dp, "0>",        zeroGreater,    FW_DEFAULT);
+    dictAppendWord(dp, "1+",        onePlus,        FW_DEFAULT);
+    dictAppendWord(dp, "1-",        oneMinus,       FW_DEFAULT);
+    dictAppendWord(dp, "2!",        twoStore,       FW_DEFAULT);
+    dictAppendWord(dp, "2*",        twoMul,         FW_DEFAULT);
+    dictAppendWord(dp, "2/",        twoDiv,         FW_DEFAULT);
+    dictAppendWord(dp, "2@",        twoFetch,       FW_DEFAULT);
+    dictAppendWord(dp, "2drop",     twoDrop,        FW_DEFAULT);
+    dictAppendWord(dp, "2dup",      twoDup,         FW_DEFAULT);
+    dictAppendWord(dp, "2over",     twoOver,        FW_DEFAULT);
+    dictAppendWord(dp, "2swap",     twoSwap,        FW_DEFAULT);
+    dictAppendWord(dp, ":",         colon,          FW_DEFAULT);
+    dictAppendWord(dp, ";",         semicolonCoIm,  FW_COMPIMMED);
+    dictAppendWord(dp, "<",         isLess,         FW_DEFAULT);
+    dictAppendWord(dp, "<#",        lessNumberSign, FW_DEFAULT);
+    dictAppendWord(dp, "=",         isEqual,        FW_DEFAULT);
+    dictAppendWord(dp, ">",         isGreater,      FW_DEFAULT);
+    dictAppendWord(dp, ">body",     toBody,         FW_DEFAULT);
+    dictAppendWord(dp, ">in",       toIn,           FW_DEFAULT);
+    dictAppendWord(dp, ">number",   toNumber,       FW_DEFAULT);
+    dictAppendWord(dp, ">r",        toRStack,       FW_DEFAULT);
+    dictAppendWord(dp, "?dup",      questionDup,    FW_DEFAULT);
+    dictAppendWord(dp, "@",         fetch,          FW_DEFAULT);
+    dictAppendWord(dp, "abort",     ficlAbort,      FW_DEFAULT);
+    dictAppendWord(dp, "accept",    accept,         FW_DEFAULT);
+    dictAppendWord(dp, "align",     align,          FW_DEFAULT);
+    dictAppendWord(dp, "aligned",   aligned,        FW_DEFAULT);
+    dictAppendWord(dp, "allot",     allot,          FW_DEFAULT);
+    dictAppendWord(dp, "and",       bitwiseAnd,     FW_DEFAULT);
+    dictAppendWord(dp, "base",      base,           FW_DEFAULT);
+    dictAppendWord(dp, "begin",     beginCoIm,      FW_COMPIMMED);
+    dictAppendWord(dp, "c!",        cStore,         FW_DEFAULT);
+    dictAppendWord(dp, "c,",        cComma,         FW_DEFAULT);
+    dictAppendWord(dp, "c@",        cFetch,         FW_DEFAULT);
+    dictAppendWord(dp, "cell+",     cellPlus,       FW_DEFAULT);
+    dictAppendWord(dp, "cells",     cells,          FW_DEFAULT);
+    dictAppendWord(dp, "char",      ficlChar,       FW_DEFAULT);
+    dictAppendWord(dp, "char+",     charPlus,       FW_DEFAULT);
+    dictAppendWord(dp, "chars",     ficlChars,      FW_DEFAULT);
+    dictAppendWord(dp, "constant",  constant,       FW_DEFAULT);
+    dictAppendWord(dp, "count",     count,          FW_DEFAULT);
+    dictAppendWord(dp, "cr",        cr,             FW_DEFAULT);
+    dictAppendWord(dp, "create",    create,         FW_DEFAULT);
+    dictAppendWord(dp, "decimal",   decimal,        FW_DEFAULT);
+    dictAppendWord(dp, "depth",     depth,          FW_DEFAULT);
+    dictAppendWord(dp, "do",        doCoIm,         FW_COMPIMMED);
+    dictAppendWord(dp, "does>",     doesCoIm,       FW_COMPIMMED);
+    dictAppendWord(dp, "drop",      drop,           FW_DEFAULT);
+    dictAppendWord(dp, "dup",       dup,            FW_DEFAULT);
+    dictAppendWord(dp, "else",      elseCoIm,       FW_COMPIMMED);
+    dictAppendWord(dp, "emit",      emit,           FW_DEFAULT);
+    dictAppendWord(dp, "environment?", environmentQ,FW_DEFAULT);
+    dictAppendWord(dp, "evaluate",  evaluate,       FW_DEFAULT);
+    dictAppendWord(dp, "execute",   execute,        FW_DEFAULT);
+    dictAppendWord(dp, "exit",      exitCoIm,       FW_COMPIMMED);
+    dictAppendWord(dp, "fill",      fill,           FW_DEFAULT);
+    dictAppendWord(dp, "find",      find,           FW_DEFAULT);
+    dictAppendWord(dp, "fm/mod",    fmSlashMod,     FW_DEFAULT);
+    dictAppendWord(dp, "here",      here,           FW_DEFAULT);
+    dictAppendWord(dp, "hex",       hex,            FW_DEFAULT);
+    dictAppendWord(dp, "hold",      hold,           FW_DEFAULT);
+    dictAppendWord(dp, "i",         loopICo,        FW_COMPILE);
+    dictAppendWord(dp, "if",        ifCoIm,         FW_COMPIMMED);
+    dictAppendWord(dp, "immediate", immediate,      FW_DEFAULT);
+    dictAppendWord(dp, "invert",    bitwiseNot,     FW_DEFAULT);
+    dictAppendWord(dp, "j",         loopJCo,        FW_COMPILE);
+    dictAppendWord(dp, "k",         loopKCo,        FW_COMPILE);
+    dictAppendWord(dp, "leave",     leaveCo,        FW_COMPILE);
+    dictAppendWord(dp, "literal",   literalIm,      FW_IMMEDIATE);
+    dictAppendWord(dp, "loop",      loopCoIm,       FW_COMPIMMED);
+    dictAppendWord(dp, "lshift",    lshift,         FW_DEFAULT);
+    dictAppendWord(dp, "m*",        mStar,          FW_DEFAULT);
+    dictAppendWord(dp, "max",       ficlMax,        FW_DEFAULT);
+    dictAppendWord(dp, "min",       ficlMin,        FW_DEFAULT);
+    dictAppendWord(dp, "mod",       ficlMod,        FW_DEFAULT);
+    dictAppendWord(dp, "move",      move,           FW_DEFAULT);
+    dictAppendWord(dp, "negate",    negate,         FW_DEFAULT);
+    dictAppendWord(dp, "or",        bitwiseOr,      FW_DEFAULT);
+    dictAppendWord(dp, "over",      over,           FW_DEFAULT);
+    dictAppendWord(dp, "postpone",  postponeCoIm,   FW_COMPIMMED);
+    dictAppendWord(dp, "quit",      quit,           FW_DEFAULT);
+    dictAppendWord(dp, "r>",        fromRStack,     FW_DEFAULT);
+    dictAppendWord(dp, "r@",        fetchRStack,    FW_DEFAULT);
+    dictAppendWord(dp, "recurse",   recurseCoIm,    FW_COMPIMMED);
+    dictAppendWord(dp, "repeat",    repeatCoIm,     FW_COMPIMMED);
+    dictAppendWord(dp, "rot",       rot,            FW_DEFAULT);
+    dictAppendWord(dp, "rshift",    rshift,         FW_DEFAULT);
+    dictAppendWord(dp, "s\"",       stringQuoteIm,  FW_IMMEDIATE);
+    dictAppendWord(dp, "s>d",       sToD,           FW_DEFAULT);
+    dictAppendWord(dp, "sign",      sign,           FW_DEFAULT);
+    dictAppendWord(dp, "sm/rem",    smSlashRem,     FW_DEFAULT);
+    dictAppendWord(dp, "source",    source,         FW_DEFAULT);
+    dictAppendWord(dp, "state",     state,          FW_DEFAULT);
+    dictAppendWord(dp, "swap",      swap,           FW_DEFAULT);
+    dictAppendWord(dp, "then",      endifCoIm,      FW_COMPIMMED);
+    pType =
+    dictAppendWord(dp, "type",      type,           FW_DEFAULT);
+    dictAppendWord(dp, "u.",        uDot,           FW_DEFAULT);
+    dictAppendWord(dp, "u<",        uIsLess,        FW_DEFAULT);
+    dictAppendWord(dp, "um*",       umStar,         FW_DEFAULT);
+    dictAppendWord(dp, "um/mod",    umSlashMod,     FW_DEFAULT);
+    dictAppendWord(dp, "unloop",    unloopCo,       FW_COMPILE);
+    dictAppendWord(dp, "until",     untilCoIm,      FW_COMPIMMED);
+    dictAppendWord(dp, "variable",  variable,       FW_DEFAULT);
+    dictAppendWord(dp, "while",     whileCoIm,      FW_COMPIMMED);
+    dictAppendWord(dp, "word",      ficlWord,       FW_DEFAULT);
+    dictAppendWord(dp, "xor",       bitwiseXor,     FW_DEFAULT);
+    dictAppendWord(dp, "[",         lbracketCoIm,   FW_COMPIMMED);
+    dictAppendWord(dp, "[\']",      bracketTickCoIm,FW_COMPIMMED);
+    dictAppendWord(dp, "[char]",    charCoIm,       FW_COMPIMMED);
+    dictAppendWord(dp, "]",         rbracket,       FW_DEFAULT);
+    /* 
+    ** CORE EXT word set...
+    ** see softcore.c for other definitions
+    */
+    dictAppendWord(dp, ".(",        dotParen,       FW_DEFAULT);
+    dictAppendWord(dp, ":noname",   colonNoName,    FW_DEFAULT);
+    dictAppendWord(dp, "?do",       qDoCoIm,        FW_COMPIMMED);
+    dictAppendWord(dp, "parse",     parse,          FW_DEFAULT);
+    dictAppendWord(dp, "pick",      pick,           FW_DEFAULT);
+    dictAppendWord(dp, "roll",      roll,           FW_DEFAULT);
+    dictAppendWord(dp, "refill",    refill,         FW_DEFAULT);
+    dictAppendWord(dp, "to",        toValue,        FW_IMMEDIATE);
+    dictAppendWord(dp, "value",     constant,       FW_DEFAULT);
+    dictAppendWord(dp, "\\",        commentLine,    FW_IMMEDIATE);
+
+
+    /*
+    ** Set CORE environment query values
+    */
+    ficlSetEnv("/counted-string",   FICL_STRING_MAX);
+    ficlSetEnv("/hold",             nPAD);
+    ficlSetEnv("/pad",              nPAD);
+    ficlSetEnv("address-unit-bits", 8);
+    ficlSetEnv("core",              FICL_TRUE);
+    ficlSetEnv("core-ext",          FICL_FALSE);
+    ficlSetEnv("floored",           FICL_FALSE);
+    ficlSetEnv("max-char",          UCHAR_MAX);
+    ficlSetEnvD("max-d",            0x7fffffff, 0xffffffff );
+    ficlSetEnv("max-n",             0x7fffffff);
+    ficlSetEnv("max-u",             0xffffffff);
+    ficlSetEnvD("max-ud",           0xffffffff, 0xffffffff);
+    ficlSetEnv("return-stack-cells",FICL_DEFAULT_STACK);
+    ficlSetEnv("stack-cells",       FICL_DEFAULT_STACK);
+
+    /*
+    ** LOCAL and LOCAL EXT
+    ** see softcore.c for implementation of locals|
+    */
+#if FICL_WANT_LOCALS
+    pLinkParen = 
+    dictAppendWord(dp, "(link)",    linkParen,      FW_COMPILE);
+    pUnLinkParen = 
+    dictAppendWord(dp, "(unlink)",  unlinkParen,    FW_COMPILE);
+    dictAppendWord(dp, "doLocal",   doLocalIm,      FW_COMPIMMED);
+    pGetLocalParen =
+    dictAppendWord(dp, "(@local)",  getLocalParen,  FW_COMPILE);
+    pToLocalParen =
+    dictAppendWord(dp, "(toLocal)", toLocalParen,   FW_COMPILE);
+    pGetLocal0 =
+    dictAppendWord(dp, "(@local0)", getLocal0,      FW_COMPILE);
+    pToLocal0 =
+    dictAppendWord(dp, "(toLocal0)",toLocal0,       FW_COMPILE);
+    pGetLocal1 =
+    dictAppendWord(dp, "(@local1)", getLocal1,      FW_COMPILE);
+    pToLocal1 =
+    dictAppendWord(dp, "(toLocal1)",toLocal1,       FW_COMPILE);
+    dictAppendWord(dp, "(local)",   localParen,     FW_COMPILE);
+
+    ficlSetEnv("locals",            FICL_TRUE);
+    ficlSetEnv("locals-ext",        FICL_TRUE);
+    ficlSetEnv("#locals",           FICL_MAX_LOCALS);
+#endif
+
+    /*
+    ** optional SEARCH-ORDER word set 
+    */
+    dictAppendWord(dp, ">search",   searchPush,     FW_DEFAULT);
+    dictAppendWord(dp, "search>",   searchPop,      FW_DEFAULT);
+    dictAppendWord(dp, "definitions",
+                                    definitions,    FW_DEFAULT);
+    dictAppendWord(dp, "forth-wordlist",  
+                                    forthWordlist,  FW_DEFAULT);
+    dictAppendWord(dp, "get-current",  
+                                    getCurrent,     FW_DEFAULT);
+    dictAppendWord(dp, "get-order", getOrder,       FW_DEFAULT);
+    dictAppendWord(dp, "search-wordlist",  
+                                    searchWordlist, FW_DEFAULT);
+    dictAppendWord(dp, "set-current",  
+                                    setCurrent,     FW_DEFAULT);
+    dictAppendWord(dp, "set-order", setOrder,       FW_DEFAULT);
+    dictAppendWord(dp, "ficl-wordlist", wordlist,   FW_DEFAULT);
+
+    /*
+    ** Set SEARCH environment query values
+    */
+    ficlSetEnv("search-order",      FICL_TRUE);
+    ficlSetEnv("search-order-ext",  FICL_TRUE);
+    ficlSetEnv("wordlists",         FICL_DEFAULT_VOCS);
+
+    /*
+    ** TOOLS and TOOLS EXT
+    */
+    dictAppendWord(dp, ".s",        displayStack,   FW_DEFAULT);
+    dictAppendWord(dp, "bye",       bye,            FW_DEFAULT);
+    dictAppendWord(dp, "forget",    forget,         FW_DEFAULT);
+    dictAppendWord(dp, "see",       see,            FW_DEFAULT);
+    dictAppendWord(dp, "words",     listWords,      FW_DEFAULT);
+
+    /*
+    ** Set TOOLS environment query values
+    */
+    ficlSetEnv("tools",            FICL_TRUE);
+    ficlSetEnv("tools-ext",        FICL_FALSE);
+
+    /*
+    ** Ficl extras
+    */
+    dictAppendWord(dp, ".env",      listEnv,        FW_DEFAULT);
+    dictAppendWord(dp, ".hash",     dictHashSummary,FW_DEFAULT);
+    dictAppendWord(dp, ".ver",      ficlVersion,    FW_DEFAULT);
+    dictAppendWord(dp, "-roll",     minusRoll,      FW_DEFAULT);
+    dictAppendWord(dp, "2constant", twoConstant,    FW_IMMEDIATE); /* DOUBLE */
+    dictAppendWord(dp, ">name",     toName,         FW_DEFAULT);
+    dictAppendWord(dp, "body>",     fromBody,       FW_DEFAULT);
+    dictAppendWord(dp, "compare",   compareString,  FW_DEFAULT);   /* STRING */
+    dictAppendWord(dp, "compile-only",
+                                    compileOnly,    FW_DEFAULT);
+    dictAppendWord(dp, "endif",     endifCoIm,      FW_COMPIMMED);
+    dictAppendWord(dp, "forget-wid",forgetWid,      FW_DEFAULT);
+    dictAppendWord(dp, "parse-word",parseNoCopy,    FW_DEFAULT);
+    dictAppendWord(dp, "sliteral",  sLiteralCoIm,   FW_COMPIMMED); /* STRING */
+    dictAppendWord(dp, "wid-set-super", 
+                                    setParentWid,   FW_DEFAULT);
+    dictAppendWord(dp, "w@",        wFetch,         FW_DEFAULT);
+    dictAppendWord(dp, "w!",        wStore,         FW_DEFAULT);
+    dictAppendWord(dp, "x.",        hexDot,         FW_DEFAULT);
+#if FICL_WANT_USER
+    dictAppendWord(dp, "(user)",    userParen,      FW_DEFAULT);
+    dictAppendWord(dp, "user",      userVariable,   FW_DEFAULT);
+#endif
+    /*
+    ** internal support words
+    */
+    pExitParen =
+    dictAppendWord(dp, "(exit)",    exitParen,      FW_COMPILE);
+    pSemiParen =
+    dictAppendWord(dp, "(;)",       semiParen,      FW_COMPILE);
+    pLitParen = 
+    dictAppendWord(dp, "(literal)", literalParen,   FW_COMPILE);
+    pStringLit =
+    dictAppendWord(dp, "(.\")",     stringLit,      FW_COMPILE);
+    pIfParen =
+    dictAppendWord(dp, "(if)",      ifParen,        FW_COMPILE);
+    pBranchParen =
+    dictAppendWord(dp, "(branch)",  branchParen,    FW_COMPILE);
+    pDoParen =
+    dictAppendWord(dp, "(do)",      doParen,        FW_COMPILE);
+    pDoesParen =
+    dictAppendWord(dp, "(does>)",   doesParen,      FW_COMPILE);
+    pQDoParen =
+    dictAppendWord(dp, "(?do)",     qDoParen,       FW_COMPILE);
+    pLoopParen =
+    dictAppendWord(dp, "(loop)",    loopParen,      FW_COMPILE);
+    pPLoopParen =
+    dictAppendWord(dp, "(+loop)",   plusLoopParen,  FW_COMPILE);
+    pInterpret =
+    dictAppendWord(dp, "interpret", interpret,      FW_DEFAULT);
+    dictAppendWord(dp, "(variable)",variableParen,  FW_COMPILE);
+    dictAppendWord(dp, "(constant)",constantParen,  FW_COMPILE);
+
+    return;
+}
+