23 files changed, 9740 insertions, 2 deletions

diff --git a/sys/boot/Makefile b/sys/boot/Makefile
index 1de594169211..cd271859639f 100644
--- a/sys/boot/Makefile
+++ b/sys/boot/Makefile
@@ -1,4 +1,7 @@
-# Pick the subdir based on the target architecture.
-SUBDIR=		${MACHINE_ARCH}
+# Build the add-in FORTH interpreter
+SUBDIR+=		ficl
+
+# Pick the machine-dependant subdir based on the target architecture.
+SUBDIR+=		${MACHINE_ARCH}
 
 .include <bsd.subdir.mk>
diff --git a/sys/boot/ficl/Makefile b/sys/boot/ficl/Makefile
new file mode 100644
index 000000000000..b3fdd27e4fda
--- /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 000000000000..e0164f59011a
--- /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 000000000000..4095701cad2a
--- /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 000000000000..2e4e436d646a
--- /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 000000000000..e02f13636aaa
--- /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 000000000000..9fcce10ad33b
--- /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 000000000000..e0164f59011a
--- /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 000000000000..4095701cad2a
--- /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 000000000000..e83000a8b4a2
--- /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 000000000000..2b7df37006bd
--- /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 000000000000..75dc35ae0da2
--- /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 000000000000..034ada519711
--- /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 000000000000..c80c2cf3f2ce
--- /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 000000000000..cd16c77b28b0
--- /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 000000000000..bcc2696b6efd
--- /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 000000000000..fc1e522f5ce4
--- /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 000000000000..d06f3cee6cf9
--- /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 000000000000..e0164f59011a
--- /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 000000000000..4095701cad2a
--- /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 000000000000..3e70195ff084
--- /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 000000000000..ebbe1c0f307c
--- /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 000000000000..dce650703906
--- /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;
+}
+