Upgrade to FICL version 3.02. Anything wrong is my fault, everything right is

due Jon Mini.

PR:		36308
Submitted by:	Jon Mini <mini@haikugeek.com>
MFC after:	4 weeks

27 files changed, 3925 insertions, 1275 deletions

diff --git a/sys/boot/ficl/Makefile b/sys/boot/ficl/Makefile
index b80ff97..9825183 100644
--- a/sys/boot/ficl/Makefile
+++ b/sys/boot/ficl/Makefile
@@ -1,8 +1,9 @@
 # $FreeBSD$
 #
 .PATH:			${.CURDIR}/${MACHINE_ARCH}
-BASE_SRCS=		dict.c ficl.c math64.c search.c stack.c tools.c \
-			prefix.c loader.c vm.c words.c
+BASE_SRCS=		dict.c ficl.c fileaccess.c float.c loader.c math64.c \
+			prefix.c search.c stack.c tools.c vm.c words.c
+
 SRCS=			${BASE_SRCS} sysdep.c softcore.c
 CLEANFILES=		softcore.c testmain testmain.o
 .if ${MACHINE_ARCH} == "alpha"
diff --git a/sys/boot/ficl/alpha/sysdep.h b/sys/boot/ficl/alpha/sysdep.h
index 0a6ca33..a53d9c9 100644
--- a/sys/boot/ficl/alpha/sysdep.h
+++ b/sys/boot/ficl/alpha/sysdep.h
@@ -9,7 +9,7 @@
 ** FICL_ROBUST is enabled. This may require some consideration
 ** in firmware systems since assert often
 ** assumes stderr/stdout.  
-** $Id: sysdep.h,v 1.6 2001-04-26 21:41:55-07 jsadler Exp jsadler $
+** $Id: sysdep.h,v 1.11 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -17,6 +17,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -39,13 +44,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: sysdep.h,v 1.6 2001-04-26 21:41:55-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
@@ -75,7 +73,6 @@
 #define FALSE 0
 #endif
 
-
 /*
 ** System dependent data type declarations...
 */
@@ -162,6 +159,7 @@ typedef struct
 #endif
 #if (FICL_MINIMAL)
 #define FICL_WANT_SOFTWORDS  0
+#define FICL_WANT_FILE       0
 #define FICL_WANT_FLOAT      0
 #define FICL_WANT_USER       0
 #define FICL_WANT_LOCALS     0
@@ -181,6 +179,17 @@ typedef struct
 #define FICL_PLATFORM_EXTEND 1
 #endif
 
+
+/*
+** FICL_WANT_FILE
+** Includes the FILE and FILE-EXT wordset and associated code. Turn this off if you do not
+** have a file system!
+** Contributed by Larry Hastings
+*/
+#if !defined (FICL_WANT_FILE)
+#define FICL_WANT_FILE 0
+#endif
+
 /*
 ** FICL_WANT_FLOAT
 ** Includes a floating point stack for the VM, and words to do float operations.
@@ -199,6 +208,14 @@ typedef struct
 #endif
 
 /*
+** FICL_EXTENDED_PREFIX enables a bunch of extra prefixes in prefix.c and prefix.fr (if
+** included as part of softcore.c)
+*/
+#if !defined FICL_EXTENDED_PREFIX
+#define FICL_EXTENDED_PREFIX 0
+#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
@@ -341,14 +358,6 @@ typedef struct
 #endif
 
 /*
-** FICL_EXTENDED_PREFIX enables a bunch of extra prefixes in prefix.c and prefix.fr (if
-** included as part of softcore.c)
-*/
-#if !defined FICL_EXTENDED_PREFIX
-#define FICL_EXTENDED_PREFIX 0
-#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
@@ -409,4 +418,15 @@ int ficlLockDictionary(short fLock);
 DPUNS ficlLongMul(FICL_UNS x, FICL_UNS y);
 UNSQR ficlLongDiv(DPUNS    q, FICL_UNS y);
 
+
+/*
+** FICL_HAVE_FTRUNCATE indicates whether the current OS supports
+** the ftruncate() function (available on most UNIXes).  This
+** function is necessary to provide the complete File-Access wordset.
+*/
+#if !defined (FICL_HAVE_FTRUNCATE)
+#define FICL_HAVE_FTRUNCATE 0
+#endif
+
+
 #endif /*__SYSDEP_H__*/
diff --git a/sys/boot/ficl/dict.c b/sys/boot/ficl/dict.c
index f5b9f15..b76d925 100644
--- a/sys/boot/ficl/dict.c
+++ b/sys/boot/ficl/dict.c
@@ -3,7 +3,7 @@
 ** Forth Inspired Command Language - dictionary methods
 ** Author: John Sadler (john_sadler@alum.mit.edu)
 ** Created: 19 July 1997
-** $Id: dict.c,v 1.6 2000-06-17 07:43:44-07 jsadler Exp jsadler $
+** $Id: dict.c,v 1.14 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** This file implements the dictionary -- FICL's model of 
@@ -22,6 +22,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -44,20 +49,12 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: dict.c,v 1.8 2001-04-26 21:41:45-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
 
 #ifdef TESTMAIN
 #include <stdio.h>
-#include <stdlib.h>
 #include <ctype.h>
 #else
 #include <stand.h>
@@ -304,16 +301,19 @@ int dictCellsUsed(FICL_DICT *pDict)
 /**************************************************************************
                         d i c t C h e c k
 ** Checks the dictionary for corruption and throws appropriate
-** errors
+** errors.
+** Input: +n number of ADDRESS UNITS (not Cells) proposed to allot
+**        -n number of ADDRESS UNITS proposed to de-allot
+**         0 just do a consistency check
 **************************************************************************/
-void dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int nCells)
+void dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int n)
 {
-    if ((nCells >= 0) && (dictCellsAvail(pDict) < nCells))
+    if ((n >= 0) && (dictCellsAvail(pDict) * (int)sizeof(CELL) < n))
     {
         vmThrowErr(pVM, "Error: dictionary full");
     }
 
-    if ((nCells <= 0) && (dictCellsUsed(pDict) < -nCells))
+    if ((n <= 0) && (dictCellsUsed(pDict) * (int)sizeof(CELL) < -n))
     {
         vmThrowErr(pVM, "Error: dictionary underflow");
     }
@@ -396,6 +396,7 @@ FICL_DICT  *dictCreateHashed(unsigned nCells, unsigned nHash)
     memset(pDict, 0, sizeof (FICL_DICT));
     pDict->dict = ficlMalloc(nAlloc);
     assert(pDict->dict);
+
     pDict->size = nCells;
     dictEmpty(pDict, nHash);
     return pDict;
@@ -460,6 +461,84 @@ void dictEmpty(FICL_DICT *pDict, unsigned nHash)
 
 
 /**************************************************************************
+                        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.
+**************************************************************************/
+#if FICL_WANT_FLOAT
+void dictHashSummary(FICL_VM *pVM)
+{
+    FICL_DICT *dp = vmGetDict(pVM);
+    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;
+}
+#endif
+
+/**************************************************************************
                         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.
@@ -471,7 +550,6 @@ int dictIncludes(FICL_DICT *pDict, void *p)
            );
 }
 
-
 /**************************************************************************
                         d i c t L o o k u p
 ** Find the FICL_WORD that matches the given name and length.
@@ -501,15 +579,16 @@ FICL_WORD *dictLookup(FICL_DICT *pDict, STRINGINFO si)
 
 
 /**************************************************************************
-                        d i c t L o o k u p L o c
+                        f i c l 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 *ficlLookupLoc(FICL_SYSTEM *pSys, STRINGINFO si)
 {
     FICL_WORD *pFW = NULL;
-    FICL_HASH *pHash = ficlGetLoc()->pForthWords;
+	FICL_DICT *pDict = pSys->dp;
+    FICL_HASH *pHash = ficlGetLoc(pSys)->pForthWords;
     int i;
     UNS16 hashCode   = hashHashCode(si);
 
diff --git a/sys/boot/ficl/ficl.c b/sys/boot/ficl/ficl.c
index d5ce084..d4370eb 100644
--- a/sys/boot/ficl/ficl.c
+++ b/sys/boot/ficl/ficl.c
@@ -3,7 +3,7 @@
 ** Forth Inspired Command Language - external interface
 ** Author: John Sadler (john_sadler@alum.mit.edu)
 ** Created: 19 July 1997
-** $Id: ficl.c,v 1.10 2001-04-26 21:41:42-07 jsadler Exp jsadler $
+** $Id: ficl.c,v 1.16 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** This is an ANS Forth interpreter written in C.
@@ -26,6 +26,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -48,13 +53,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: ficl.c,v 1.10 2001-04-26 21:41:42-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
@@ -70,19 +68,19 @@
 
 /*
 ** 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
+** Each FICL_SYSTEM builds a global dictionary during its start
+** sequence. This is shared by all virtual machines of that system.
+** Therefore only one VM 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_SYSTEM *pSys = NULL;
-
 static int defaultStack = FICL_DEFAULT_STACK;
-static int defaultDict  = FICL_DEFAULT_DICT;
+
+
+static void ficlSetVersionEnv(FICL_SYSTEM *pSys);
 
 
 /**************************************************************************
@@ -96,67 +94,94 @@ static int defaultDict  = FICL_DEFAULT_DICT;
 ** 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)
+FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi)
 {
-    pSys = ficlMalloc(sizeof (FICL_SYSTEM));
+    int nDictCells;
+    int nEnvCells;
+    FICL_SYSTEM *pSys = ficlMalloc(sizeof (FICL_SYSTEM));
+
     assert(pSys);
+    assert(fsi->size == sizeof (FICL_SYSTEM_INFO));
 
     memset(pSys, 0, sizeof (FICL_SYSTEM));
 
+    nDictCells = fsi->nDictCells;
     if (nDictCells <= 0)
-        nDictCells = defaultDict;
+        nDictCells = FICL_DEFAULT_DICT;
+
+    nEnvCells = fsi->nEnvCells;
+    if (nEnvCells <= 0)
+        nEnvCells = FICL_DEFAULT_DICT;
 
     pSys->dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE);
     pSys->dp->pForthWords->name = "forth-wordlist";
 
-    pSys->envp = dictCreate((unsigned)FICL_DEFAULT_ENV);
+    pSys->envp = dictCreate((unsigned)nEnvCells);
     pSys->envp->pForthWords->name = "environment";
 
+    pSys->textOut = fsi->textOut;
+    pSys->pExtend = fsi->pExtend;
+
 #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
+    ** The need to balance search speed with the cost of the 'empty'
     ** operation led me to select a single-threaded list...
     */
     pSys->localp = dictCreate((unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD);
 #endif
 
     /*
-    ** Establish the parse order. Note that prefixes precede numbers -
-    ** this allows constructs like "0b101010" which would parse as a
-    ** valid hex value otherwise.
-    */
-    ficlCompilePrefix(pSys);
-    ficlAddPrecompiledParseStep(pSys, "number?", ficlParseNumber);
-
-    /*
     ** Build the precompiled dictionary and load softwords. We need a temporary
     ** VM to do this - ficlNewVM links one to the head of the system VM list.
     ** ficlCompilePlatform (defined in win32.c, for example) adds platform specific words.
     */
     ficlCompileCore(pSys);
+    ficlCompilePrefix(pSys);
 #if FICL_WANT_FLOAT
     ficlCompileFloat(pSys);
 #endif
-
 #if FICL_PLATFORM_EXTEND
     ficlCompilePlatform(pSys);
 #endif
+    ficlSetVersionEnv(pSys);
+
+    /*
+    ** Establish the parse order. Note that prefixes precede numbers -
+    ** this allows constructs like "0b101010" which might parse as a
+    ** hex value otherwise.
+    */
+    ficlAddPrecompiledParseStep(pSys, "?prefix", ficlParsePrefix);
+    ficlAddPrecompiledParseStep(pSys, "?number", ficlParseNumber);
+#if FICL_WANT_FLOAT
+    ficlAddPrecompiledParseStep(pSys, ">float", ficlParseFloatNumber);
+#endif
 
     /*
-    ** Now we can create a VM to compile the softwords. Note that the VM initialization
-    ** code needs to be able to find "interpret" in the dictionary in order to 
-    ** succeed, so as presently constructed ficlCompileCore has to finish before
-    ** a VM can be created successfully.
+    ** Now create a temporary VM to compile the softwords. Since all VMs are
+    ** linked into the vmList of FICL_SYSTEM, we don't have to pass the VM
+    ** to ficlCompileSoftCore -- it just hijacks whatever it finds in the VM list.
+    ** ficl 2.05: vmCreate no longer depends on the presence of INTERPRET in the
+    ** dictionary, so a VM can be created before the dictionary is built. It just
+    ** can't do much...
     */
-    ficlNewVM();
+    ficlNewVM(pSys);
     ficlCompileSoftCore(pSys);
     ficlFreeVM(pSys->vmList);
 
 
-    return;
+    return pSys;
+}
+
+
+FICL_SYSTEM *ficlInitSystem(int nDictCells)
+{
+    FICL_SYSTEM_INFO fsi;
+    ficlInitInfo(&fsi);
+    fsi.nDictCells = nDictCells;
+    return ficlInitSystemEx(&fsi);
 }
 
 
@@ -226,11 +251,13 @@ void ficlListParseSteps(FICL_VM *pVM)
 ** Create a new virtual machine and link it into the system list
 ** of VMs for later cleanup by ficlTermSystem.
 **************************************************************************/
-FICL_VM *ficlNewVM(void)
+FICL_VM *ficlNewVM(FICL_SYSTEM *pSys)
 {
     FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack);
     pVM->link = pSys->vmList;
     pVM->pSys = pSys;
+    pVM->pExtend = pSys->pExtend;
+    vmSetTextOut(pVM, pSys->textOut);
 
     pSys->vmList = pVM;
     return pVM;
@@ -246,6 +273,7 @@ FICL_VM *ficlNewVM(void)
 **************************************************************************/
 void ficlFreeVM(FICL_VM *pVM)
 {
+    FICL_SYSTEM *pSys = pVM->pSys;
     FICL_VM *pList = pSys->vmList;
 
     assert(pVM != 0);
@@ -284,10 +312,12 @@ void ficlFreeVM(FICL_VM *pVM)
 ** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR!
 ** 
 **************************************************************************/
-int ficlBuild(char *name, FICL_CODE code, char flags)
+int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags)
 {
+#if FICL_MULTITHREAD
     int err = ficlLockDictionary(TRUE);
     if (err) return err;
+#endif /* FICL_MULTITHREAD */
 
     assert(dictCellsAvail(pSys->dp) > sizeof (FICL_WORD) / sizeof (CELL));
     dictAppendWord(pSys->dp, name, code, flags);
@@ -298,6 +328,21 @@ int ficlBuild(char *name, FICL_CODE code, char flags)
 
 
 /**************************************************************************
+                    f i c l E v a l u a t e
+** Wrapper for ficlExec() which sets SOURCE-ID to -1.
+**************************************************************************/
+int ficlEvaluate(FICL_VM *pVM, char *pText)
+{
+    int returnValue;
+    CELL id = pVM->sourceID;
+    pVM->sourceID.i = -1;
+    returnValue = ficlExecC(pVM, pText, -1);
+    pVM->sourceID = id;
+    return returnValue;
+}
+
+
+/**************************************************************************
                         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
@@ -322,23 +367,16 @@ int ficlExec(FICL_VM *pVM, char *pText)
 
 int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
 {
-    FICL_WORD **pInterp =  pSys->pInterp;
-    FICL_DICT *dp = pSys->dp;
+    FICL_SYSTEM *pSys = pVM->pSys;
+    FICL_DICT   *dp   = pSys->dp;
 
     int        except;
     jmp_buf    vmState;
     jmp_buf   *oldState;
     TIB        saveTib;
 
-    if (!pInterp[0])
-    {
-        pInterp[0] = ficlLookup("interpret");
-        pInterp[1] = ficlLookup("(branch)");
-        pInterp[2] = (FICL_WORD *)(void *)(-2);
-    }
-    
-    assert(pInterp[0]);
     assert(pVM);
+    assert(pSys->pInterp[0]);
 
     if (size < 0)
         size = strlen(pText);
@@ -362,7 +400,7 @@ int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
         }
         else
         {   /* set VM up to interpret text */
-            vmPushIP(pVM, &pInterp[0]);
+            vmPushIP(pVM, &(pSys->pInterp[0]));
         }
 
         vmInnerLoop(pVM);
@@ -438,17 +476,13 @@ int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
 **************************************************************************/
 int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord)
 {
-    static FICL_WORD *pQuit = NULL;
     int        except;
     jmp_buf    vmState;
     jmp_buf   *oldState;
     FICL_WORD *oldRunningWord;
 
-    if (!pQuit)
-        pQuit = ficlLookup("exit-inner");
-
     assert(pVM);
-    assert(pQuit);
+    assert(pVM->pSys->pExitInner);
     
     /* 
     ** Save the runningword so that RESTART behaves correctly
@@ -465,7 +499,7 @@ int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord)
     if (except)
         vmPopIP(pVM);
     else
-        vmPushIP(pVM, &pQuit);
+        vmPushIP(pVM, &(pVM->pSys->pExitInner));
 
     switch (except)
     {
@@ -506,7 +540,7 @@ int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord)
 ** found, return the address of the corresponding FICL_WORD. Otherwise
 ** return NULL.
 **************************************************************************/
-FICL_WORD *ficlLookup(char *name)
+FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name)
 {
     STRINGINFO si;
     SI_PSZ(si, name);
@@ -518,7 +552,7 @@ FICL_WORD *ficlLookup(char *name)
                         f i c l G e t D i c t
 ** Returns the address of the system dictionary
 **************************************************************************/
-FICL_DICT *ficlGetDict(void)
+FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys)
 {
     return pSys->dp;
 }
@@ -528,7 +562,7 @@ FICL_DICT *ficlGetDict(void)
                         f i c l G e t E n v
 ** Returns the address of the system environment space
 **************************************************************************/
-FICL_DICT *ficlGetEnv(void)
+FICL_DICT *ficlGetEnv(FICL_SYSTEM *pSys)
 {
     return pSys->envp;
 }
@@ -539,7 +573,7 @@ FICL_DICT *ficlGetEnv(void)
 ** Create an environment variable with a one-CELL payload. ficlSetEnvD
 ** makes one with a two-CELL payload.
 **************************************************************************/
-void ficlSetEnv(char *name, FICL_UNS value)
+void ficlSetEnv(FICL_SYSTEM *pSys, char *name, FICL_UNS value)
 {
     STRINGINFO si;
     FICL_WORD *pFW;
@@ -561,7 +595,7 @@ void ficlSetEnv(char *name, FICL_UNS value)
     return;
 }
 
-void ficlSetEnvD(char *name, FICL_UNS hi, FICL_UNS lo)
+void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo)
 {
     FICL_WORD *pFW;
     STRINGINFO si;
@@ -591,7 +625,7 @@ void ficlSetEnvD(char *name, FICL_UNS hi, FICL_UNS lo)
 ** only used during compilation, and is shared by all VMs.
 **************************************************************************/
 #if FICL_WANT_LOCALS
-FICL_DICT *ficlGetLoc(void)
+FICL_DICT *ficlGetLoc(FICL_SYSTEM *pSys)
 {
     return pSys->localp;
 }
@@ -620,7 +654,7 @@ int ficlSetStackSize(int nStackCells)
 ** 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)
+void ficlTermSystem(FICL_SYSTEM *pSys)
 {
     if (pSys->dp)
         dictDelete(pSys->dp);
@@ -649,3 +683,14 @@ void ficlTermSystem(void)
 }
 
 
+/**************************************************************************
+                        f i c l S e t V e r s i o n E n v
+** Create a double cell environment constant for the version ID
+**************************************************************************/
+static void ficlSetVersionEnv(FICL_SYSTEM *pSys)
+{
+    ficlSetEnvD(pSys, "ficl-version", FICL_VER_MAJOR, FICL_VER_MINOR);
+    ficlSetEnv (pSys, "ficl-robust",  FICL_ROBUST);
+    return;
+}
+
diff --git a/sys/boot/ficl/ficl.h b/sys/boot/ficl/ficl.h
index b0ee3b2..98d56a5 100644
--- a/sys/boot/ficl/ficl.h
+++ b/sys/boot/ficl/ficl.h
@@ -3,7 +3,8 @@
 ** Forth Inspired Command Language
 ** Author: John Sadler (john_sadler@alum.mit.edu)
 ** Created: 19 July 1997
-** $Id: ficl.h,v 1.11 2001-04-26 21:41:48-07 jsadler Exp jsadler $
+** Dedicated to RHS, in loving memory
+** $Id: ficl.h,v 1.18 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -11,6 +12,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -33,13 +39,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: ficl.h,v 1.11 2001-04-26 21:41:48-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
@@ -125,17 +124,14 @@
 ** 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,
+** 2. Ficl uses the PAD in some 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
+**   http://ficl.sourceforge.net
 ** Check this website for Forth literature (including the ANSI standard)
 **   http://www.taygeta.com/forthlit.html
 ** and here for software and more links
@@ -154,7 +150,7 @@
 ** - 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
+** - 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
@@ -228,15 +224,22 @@ extern "C" {
 ** Forward declarations... read on.
 */
 struct ficl_word;
+typedef struct ficl_word FICL_WORD;
 struct vm;
+typedef struct vm FICL_VM;
 struct ficl_dict;
+typedef struct ficl_dict FICL_DICT;
 struct ficl_system;
 typedef struct ficl_system FICL_SYSTEM;
+struct ficl_system_info;
+typedef struct ficl_system_info FICL_SYSTEM_INFO;
 
 /* 
 ** the Good Stuff starts here...
 */
-#define FICL_VER    "2.05"
+#define FICL_VER        "3.02"
+#define FICL_VER_MAJOR  3
+#define FICL_VER_MINOR  2
 #if !defined (FICL_PROMPT)
 #define FICL_PROMPT "ok> "
 #endif
@@ -254,7 +257,8 @@ typedef struct ficl_system FICL_SYSTEM;
 /*
 ** A CELL is the main storage type. It must be large enough
 ** to contain a pointer or a scalar. In order to accommodate 
-** 32 bit and 64 bit processors, use abstract types for i and u.
+** 32 bit and 64 bit processors, use abstract types for int, 
+** unsigned, and float.
 */
 typedef union _cell
 {
@@ -268,7 +272,7 @@ typedef union _cell
 } CELL;
 
 /*
-** LVALUEtoCELL does a little pointer trickery to cast any 32 bit
+** LVALUEtoCELL does a little pointer trickery to cast any CELL sized
 ** lvalue (informal definition: an expression whose result has an
 ** address) to CELL. Remember that constants and casts are NOT
 ** themselves lvalues!
@@ -363,59 +367,59 @@ typedef struct _ficlStack
 /*
 ** 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);
-FICL_UNS    stackPopUNS(FICL_STACK *pStack);
-FICL_INT    stackPopINT(FICL_STACK *pStack);
-void        stackPush  (FICL_STACK *pStack, CELL c);
+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);
+FICL_UNS    stackPopUNS   (FICL_STACK *pStack);
+FICL_INT    stackPopINT   (FICL_STACK *pStack);
+void        stackPush     (FICL_STACK *pStack, CELL c);
 void        stackPushPtr  (FICL_STACK *pStack, void *ptr);
-void        stackPushUNS(FICL_STACK *pStack, FICL_UNS u);
-void        stackPushINT(FICL_STACK *pStack, FICL_INT 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);
+void        stackPushUNS  (FICL_STACK *pStack, FICL_UNS u);
+void        stackPushINT  (FICL_STACK *pStack, FICL_INT 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);
 
 #if (FICL_WANT_FLOAT)
 float       stackPopFloat (FICL_STACK *pStack);
-void        stackPushFloat(FICL_STACK *pStack, float f);
+void        stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f);
 #endif
 
 /*
 ** Shortcuts (Guy Carver)
 */
-#define PUSHPTR(p)  stackPushPtr(pVM->pStack,p)
-#define PUSHUNS(u)  stackPushUNS(pVM->pStack,u)
-#define PUSHINT(i)  stackPushINT(pVM->pStack,i)
-#define PUSHFLOAT(f)    stackPushFloat(pVM->fStack,f)
-#define PUSH(c)     stackPush(pVM->pStack,c)
-#define POPPTR()    stackPopPtr(pVM->pStack)
-#define POPUNS()    stackPopUNS(pVM->pStack)
-#define POPINT()    stackPopINT(pVM->pStack)
-#define POPFLOAT()  stackPopFloat(pVM->fStack)
-#define POP()       stackPop(pVM->pStack)
-#define GETTOP()    stackGetTop(pVM->pStack)
-#define SETTOP(c)   stackSetTop(pVM->pStack,LVALUEtoCELL(c))
-#define GETTOPF()   stackGetTop(pVM->fStack)
-#define SETTOPF(c)  stackSetTop(pVM->fStack,LVALUEtoCELL(c))
-#define STORE(n,c)  stackStore(pVM->pStack,n,LVALUEtoCELL(c))
-#define DEPTH()     stackDepth(pVM->pStack)
-#define DROP(n)     stackDrop(pVM->pStack,n)
-#define DROPF(n)    stackDrop(pVM->fStack,n)
-#define FETCH(n)    stackFetch(pVM->pStack,n)
-#define PICK(n)     stackPick(pVM->pStack,n)
-#define PICKF(n)    stackPick(pVM->fStack,n)
-#define ROLL(n)     stackRoll(pVM->pStack,n)
-#define ROLLF(n)    stackRoll(pVM->fStack,n)
+#define PUSHPTR(p)   stackPushPtr(pVM->pStack,p)
+#define PUSHUNS(u)   stackPushUNS(pVM->pStack,u)
+#define PUSHINT(i)   stackPushINT(pVM->pStack,i)
+#define PUSHFLOAT(f) stackPushFloat(pVM->fStack,f)
+#define PUSH(c)      stackPush(pVM->pStack,c)
+#define POPPTR()     stackPopPtr(pVM->pStack)
+#define POPUNS()     stackPopUNS(pVM->pStack)
+#define POPINT()     stackPopINT(pVM->pStack)
+#define POPFLOAT()   stackPopFloat(pVM->fStack)
+#define POP()        stackPop(pVM->pStack)
+#define GETTOP()     stackGetTop(pVM->pStack)
+#define SETTOP(c)    stackSetTop(pVM->pStack,LVALUEtoCELL(c))
+#define GETTOPF()    stackGetTop(pVM->fStack)
+#define SETTOPF(c)   stackSetTop(pVM->fStack,LVALUEtoCELL(c))
+#define STORE(n,c)   stackStore(pVM->pStack,n,LVALUEtoCELL(c))
+#define DEPTH()      stackDepth(pVM->pStack)
+#define DROP(n)      stackDrop(pVM->pStack,n)
+#define DROPF(n)     stackDrop(pVM->fStack,n)
+#define FETCH(n)     stackFetch(pVM->pStack,n)
+#define PICK(n)      stackPick(pVM->pStack,n)
+#define PICKF(n)     stackPick(pVM->fStack,n)
+#define ROLL(n)      stackRoll(pVM->pStack,n)
+#define ROLLF(n)     stackRoll(pVM->fStack,n)
 
 /* 
 ** The virtual machine (VM) contains the state for one interpreter.
@@ -429,7 +433,7 @@ void        stackPushFloat(FICL_STACK *pStack, float f);
 ** Throw an exception
 */
 
-typedef struct ficl_word ** IPTYPE; /* the VM's instruction pointer */
+typedef FICL_WORD ** IPTYPE; /* the VM's instruction pointer */
 
 /*
 ** Each VM has a placeholder for an output function -
@@ -437,7 +441,7 @@ typedef struct ficl_word ** IPTYPE; /* the VM's instruction pointer */
 ** through a different device. If you specify no
 ** OUTFUNC, it defaults to ficlTextOut.
 */
-typedef void (*OUTFUNC)(struct vm *pVM, char *text, int fNewline);
+typedef void (*OUTFUNC)(FICL_VM *pVM, char *text, int fNewline);
 
 /*
 ** Each VM operates in one of two non-error states: interpreting
@@ -468,17 +472,16 @@ typedef void (*OUTFUNC)(struct vm *pVM, char *text, int fNewline);
 /*
 ** OK - now we can really define the VM...
 */
-typedef struct vm
+struct vm
 {
     FICL_SYSTEM    *pSys;       /* Which system this VM belongs to  */
-    struct vm      *link;       /* Ficl keeps a VM list for simple teardown */
+    FICL_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             */
+    void *          pExtend;    /* vm extension pointer for app use - initialized from FICL_SYSTEM */
     short           fRestart;   /* Set TRUE to restart runningWord  */
     IPTYPE          ip;         /* instruction pointer              */
-    struct ficl_word 
-                   *runningWord;/* address of currently running word (often just *(ip-1) ) */
+    FICL_WORD      *runningWord;/* address of currently running word (often just *(ip-1) ) */
     FICL_UNS        state;      /* compiling or interpreting        */
     FICL_UNS        base;       /* number conversion base           */
     FICL_STACK     *pStack;     /* param stack                      */
@@ -486,13 +489,13 @@ typedef struct vm
 #if FICL_WANT_FLOAT
     FICL_STACK     *fStack;     /* float stack (optional)           */
 #endif
-    CELL            sourceID;   /* -1 if string, 0 if normal input  */
+    CELL            sourceID;   /* -1 if EVALUATE, 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
@@ -518,10 +521,10 @@ typedef void (*FICL_CODE)(FICL_VM *pVm);
 ** 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.
+** the dictionary ahead of the word struct, rather than using
+** a fixed size array for each name.
 */
-typedef struct ficl_word
+struct ficl_word
 {
     struct ficl_word *link;     /* Previous word in the dictionary      */
     UNS16 hash;
@@ -530,7 +533,7 @@ typedef struct ficl_word
     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
@@ -546,6 +549,7 @@ int wordIsCompileOnly(FICL_WORD *pFW);
 #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_ISOBJECT     8   /* word is an object or object member variable */
 
 #define FW_COMPIMMED    (FW_IMMEDIATE | FW_COMPILE)
 #define FW_DEFAULT      0
@@ -566,28 +570,27 @@ int wordIsCompileOnly(FICL_WORD *pFW);
 
 
 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);
+FICL_VM *   vmCreate       (FICL_VM *pVM, unsigned nPStack, unsigned nRStack);
+void        vmDelete       (FICL_VM *pVM);
+void        vmExecute      (FICL_VM *pVM, FICL_WORD *pWord);
+FICL_DICT  *vmGetDict      (FICL_VM *pVM);
+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);
 STRINGINFO  vmParseStringEx(FICL_VM *pVM, char delimiter, char fSkipLeading);
-CELL        vmPop(FICL_VM *pVM);
-void        vmPush(FICL_VM *pVM, CELL c);
-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);
-#if FICL_WANT_DEBUGGER
-void        vmStep(FICL_VM *pVM);
-#endif
-void        vmTextOut(FICL_VM *pVM, char *text, int fNewline);
-void        vmThrow  (FICL_VM *pVM, int except);
-void        vmThrowErr(FICL_VM *pVM, char *fmt, ...);
+CELL        vmPop          (FICL_VM *pVM);
+void        vmPush         (FICL_VM *pVM, CELL c);
+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        vmTextOut      (FICL_VM *pVM, char *text, int fNewline);
+void        vmThrow        (FICL_VM *pVM, int except);
+void        vmThrowErr     (FICL_VM *pVM, char *fmt, ...);
 
 #define vmGetRunningWord(pVM) ((pVM)->runningWord)
 
@@ -599,7 +602,7 @@ void        vmThrowErr(FICL_VM *pVM, char *fmt, ...);
 #define M_VM_STEP(pVM) \
         FICL_WORD *tempFW = *(pVM)->ip++; \
         (pVM)->runningWord = tempFW; \
-        tempFW->code(pVM); \
+        tempFW->code(pVM); 
 
 #define M_INNER_LOOP(pVM) \
     for (;;)  { M_VM_STEP(pVM) }
@@ -632,11 +635,11 @@ void        vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells);
 ** 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, FICL_INT nChars, TIB *pSaveTib);
-void        vmPopTib(FICL_VM *pVM, TIB *pTib);
-#define     vmGetInBuf(pVM) ((pVM)->tib.cp + (pVM)->tib.index)
-#define     vmGetInBufLen(pVM) ((pVM)->tib.end - (pVM)->tib.cp)
-#define     vmGetInBufEnd(pVM) ((pVM)->tib.end)
+void        vmPushTib  (FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib);
+void        vmPopTib   (FICL_VM *pVM, TIB *pTib);
+#define     vmGetInBuf(pVM)      ((pVM)->tib.cp + (pVM)->tib.index)
+#define     vmGetInBufLen(pVM)   ((pVM)->tib.end - (pVM)->tib.cp)
+#define     vmGetInBufEnd(pVM)   ((pVM)->tib.end)
 #define     vmGetTibIndex(pVM)    (pVM)->tib.index
 #define     vmSetTibIndex(pVM, i) (pVM)->tib.index = i
 #define     vmUpdateTib(pVM, str) (pVM)->tib.index = (str) - (pVM)->tib.cp
@@ -686,13 +689,11 @@ typedef struct ficl_hash
     FICL_WORD *table[1];
 } FICL_HASH;
 
-void        hashForget(FICL_HASH *pHash, void *where);
-UNS16       hashHashCode(STRINGINFO si);
+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);
+FICL_WORD  *hashLookup    (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
@@ -725,7 +726,7 @@ void        hashReset(FICL_HASH *pHash);
 ** 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
+struct ficl_dict
 {
     CELL *here;
     FICL_WORD *smudge;
@@ -735,16 +736,16 @@ typedef struct ficl_dict
     int        nLists;
     unsigned   size;    /* Number of cells in dict (total)*/
     CELL       *dict;   /* 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, 
+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);
@@ -752,25 +753,28 @@ FICL_WORD  *dictAppendWord2(FICL_DICT *pDict,
                            STRINGINFO si, 
                            FICL_CODE pCode, 
                            UNS8 flags);
-void        dictAppendUNS(FICL_DICT *pDict, FICL_UNS u);
-int         dictCellsAvail(FICL_DICT *pDict);
-int         dictCellsUsed (FICL_DICT *pDict);
-void        dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int nCells);
+void        dictAppendUNS  (FICL_DICT *pDict, FICL_UNS u);
+int         dictCellsAvail (FICL_DICT *pDict);
+int         dictCellsUsed  (FICL_DICT *pDict);
+void        dictCheck      (FICL_DICT *pDict, FICL_VM *pVM, int n);
 FICL_DICT  *dictCreate(unsigned nCELLS);
 FICL_DICT  *dictCreateHashed(unsigned nCells, unsigned nHash);
 FICL_HASH  *dictCreateWordlist(FICL_DICT *dp, int nBuckets);
-void        dictDelete(FICL_DICT *pDict);
-void        dictEmpty(FICL_DICT *pDict, unsigned nHash);
-int         dictIncludes(FICL_DICT *pDict, void *p);
-FICL_WORD  *dictLookup(FICL_DICT *pDict, STRINGINFO si);
+void        dictDelete     (FICL_DICT *pDict);
+void        dictEmpty      (FICL_DICT *pDict, unsigned nHash);
+#if FICL_WANT_FLOAT
+void        dictHashSummary(FICL_VM *pVM);
+#endif
+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);
+FICL_WORD  *ficlLookupLoc  (FICL_SYSTEM *pSys, STRINGINFO si);
 #endif
 void        dictResetSearchOrder(FICL_DICT *pDict);
-void        dictSetFlags(FICL_DICT *pDict, UNS8 set, UNS8 clr);
+void        dictSetFlags   (FICL_DICT *pDict, UNS8 set, UNS8 clr);
 void        dictSetImmediate(FICL_DICT *pDict);
-void        dictUnsmudge(FICL_DICT *pDict);
-CELL       *dictWhere(FICL_DICT *pDict);
+void        dictUnsmudge   (FICL_DICT *pDict);
+CELL       *dictWhere      (FICL_DICT *pDict);
 
 
 /* 
@@ -807,6 +811,23 @@ void ficlAddPrecompiledParseStep(FICL_SYSTEM *pSys, char *name, FICL_PARSE_STEP
 void ficlListParseSteps(FICL_VM *pVM);
 
 /*
+** FICL_BREAKPOINT record.
+** origXT - if NULL, this breakpoint is unused. Otherwise it stores the xt 
+** that the breakpoint overwrote. This is restored to the dictionary when the
+** BP executes or gets cleared
+** address - the location of the breakpoint (address of the instruction that
+**           has been replaced with the breakpoint trap
+** origXT  - The original contents of the location with the breakpoint
+** Note: address is NULL when this breakpoint is empty
+*/
+typedef struct FICL_BREAKPOINT
+{
+    void      *address;
+    FICL_WORD *origXT;
+} FICL_BREAKPOINT;
+
+
+/*
 ** F I C L _ S Y S T E M
 ** The top level data structure of the system - ficl_system ties a list of
 ** virtual machines with their corresponding dictionaries. Ficl 3.0 will
@@ -814,17 +835,13 @@ void ficlListParseSteps(FICL_VM *pVM);
 ** to separate dictionaries with some constraints. 
 ** The present model allows multiple sessions to one dictionary provided
 ** you implement ficlLockDictionary() as specified in sysdep.h
-**
-** RESTRICTIONS: due to the use of static variables in words.c for compiling
-** comtrol structures faster, if you use multiple ficl systems these variables
-** will point into the most recently initialized dictionary - this is probably
-** not a problem provided the precompiled dictionaries are identical for 
-** all systems.
+** Note: the pExtend pointer is there to provide context for applications. It is copied
+** to each VM's pExtend field as that VM is created.
 */
 struct ficl_system 
 {
     FICL_SYSTEM *link;
-    FICL_WORD *parseList[FICL_MAX_PARSE_STEPS];
+    void *pExtend;      /* Initializes VM's pExtend pointer (for application use) */
     FICL_VM *vmList;
     FICL_DICT *dp;
     FICL_DICT *envp;
@@ -832,8 +849,57 @@ struct ficl_system
     FICL_DICT *localp;
 #endif
     FICL_WORD *pInterp[3];
+    FICL_WORD *parseList[FICL_MAX_PARSE_STEPS];
+	OUTFUNC    textOut;
+
+	FICL_WORD *pBranchParen;
+	FICL_WORD *pDoParen;
+	FICL_WORD *pDoesParen;
+	FICL_WORD *pExitInner;
+	FICL_WORD *pExitParen;
+	FICL_WORD *pIfParen;
+	FICL_WORD *pInterpret;
+	FICL_WORD *pLitParen;
+	FICL_WORD *pTwoLitParen;
+	FICL_WORD *pLoopParen;
+	FICL_WORD *pPLoopParen;
+	FICL_WORD *pQDoParen;
+	FICL_WORD *pSemiParen;
+	FICL_WORD *pStore;
+	FICL_WORD *pCStringLit;
+	FICL_WORD *pStringLit;
+
+#if FICL_WANT_LOCALS
+	FICL_WORD *pGetLocalParen;
+	FICL_WORD *pGet2LocalParen;
+	FICL_WORD *pGetLocal0;
+	FICL_WORD *pGetLocal1;
+	FICL_WORD *pToLocalParen;
+	FICL_WORD *pTo2LocalParen;
+	FICL_WORD *pToLocal0;
+	FICL_WORD *pToLocal1;
+	FICL_WORD *pLinkParen;
+	FICL_WORD *pUnLinkParen;
+	FICL_INT   nLocals;
+	CELL *pMarkLocals;
+#endif
+
+	FICL_BREAKPOINT bpStep;
 };
 
+struct ficl_system_info
+{
+	int size;           /* structure size tag for versioning */
+	int nDictCells;     /* Size of system's Dictionary */
+	OUTFUNC textOut;    /* default textOut function */
+	void *pExtend;      /* Initializes VM's pExtend pointer - for application use */
+    int nEnvCells;      /* Size of Environment dictionary */
+};
+
+
+#define ficlInitInfo(x) { memset((x), 0, sizeof(FICL_SYSTEM_INFO)); \
+         (x)->size = sizeof(FICL_SYSTEM_INFO); }
+
 /*
 ** External interface to FICL...
 */
@@ -841,7 +907,8 @@ struct ficl_system
 ** 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.
+** You can specify the address and size of the allocated area.
+** Using ficlInitSystemEx you can also specify the text output function.
 ** 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.
@@ -849,7 +916,10 @@ struct ficl_system
 ** 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);
+FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi);
+
+/* Deprecated call */
+FICL_SYSTEM *ficlInitSystem(int nDictCells);
 
 /*
 ** f i c l T e r m S y s t e m
@@ -857,7 +927,17 @@ void       ficlInitSystem(int nDictCells);
 ** were created with ficlNewVM (see below). Call this function to
 ** reclaim all memory used by the dictionary and VMs.
 */
-void       ficlTermSystem(void);
+void       ficlTermSystem(FICL_SYSTEM *pSys);
+
+/*
+** f i c l E v a l u a t e
+** Evaluates a block of input text in the context of the
+** specified interpreter. Also sets SOURCE-ID properly.
+**
+** PLEASE USE THIS FUNCTION when throwing a hard-coded
+** string to the FICL interpreter.
+*/
+int        ficlEvaluate(FICL_VM *pVM, char *pText);
 
 /*
 ** f i c l E x e c
@@ -880,6 +960,10 @@ void       ficlTermSystem(void);
 **      commands.
 ** Preconditions: successful execution of ficlInitSystem,
 **      Successful creation and init of the VM by ficlNewVM (or equiv)
+**
+** If you call ficlExec() or one of its brothers, you MUST
+** ensure pVM->sourceID was set to a sensible value.
+** ficlExec() explicitly DOES NOT manage SOURCE-ID for you.
 */
 int        ficlExec (FICL_VM *pVM, char *pText);
 int        ficlExecC(FICL_VM *pVM, char *pText, FICL_INT nChars);
@@ -899,7 +983,7 @@ int        ficlExecFD(FICL_VM *pVM, int fd);
 ** address of the VM, or NULL if an error occurs.
 ** Precondition: successful execution of ficlInitSystem
 */
-FICL_VM   *ficlNewVM(void);
+FICL_VM   *ficlNewVM(FICL_SYSTEM *pSys);
 
 /*
 ** Force deletion of a VM. You do not need to do this 
@@ -922,19 +1006,19 @@ int ficlSetStackSize(int nStackCells);
 ** dictionary with the given name, or NULL if no match.
 ** Precondition: successful execution of ficlInitSystem
 */
-FICL_WORD *ficlLookup(char *name);
+FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, 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, FICL_UNS value);
-void       ficlSetEnvD(char *name, FICL_UNS hi, FICL_UNS lo);
+FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys);
+FICL_DICT *ficlGetEnv (FICL_SYSTEM *pSys);
+void       ficlSetEnv (FICL_SYSTEM *pSys, char *name, FICL_UNS value);
+void       ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo);
 #if FICL_WANT_LOCALS
-FICL_DICT *ficlGetLoc(void);
+FICL_DICT *ficlGetLoc (FICL_SYSTEM *pSys);
 #endif
 /* 
 ** f i c l B u i l d
@@ -952,7 +1036,7 @@ FICL_DICT *ficlGetLoc(void);
 **          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);
+int        ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags);
 
 /* 
 ** f i c l C o m p i l e C o r e
@@ -964,12 +1048,15 @@ void       ficlCompilePrefix(FICL_SYSTEM *pSys);
 void       ficlCompileSearch(FICL_SYSTEM *pSys);
 void       ficlCompileSoftCore(FICL_SYSTEM *pSys);
 void       ficlCompileTools(FICL_SYSTEM *pSys);
+void       ficlCompileFile(FICL_SYSTEM *pSys);
 #if FICL_WANT_FLOAT
 void       ficlCompileFloat(FICL_SYSTEM *pSys);
+int        ficlParseFloatNumber( FICL_VM *pVM, STRINGINFO si ); /* float.c */
 #endif
 #if FICL_PLATFORM_EXTEND
 void       ficlCompilePlatform(FICL_SYSTEM *pSys);
 #endif
+int        ficlParsePrefix(FICL_VM *pVM, STRINGINFO si);
 
 /*
 ** from words.c...
@@ -983,7 +1070,7 @@ void       parseStepParen(FICL_VM *pVM);
 /*
 ** From tools.c
 */
-int        isAFiclWord(FICL_WORD *pFW);
+int        isAFiclWord(FICL_DICT *pd, FICL_WORD *pFW);
 
 /* 
 ** The following supports SEE and the debugger.
@@ -1003,9 +1090,13 @@ typedef enum
     PRIMITIVE,
     QDO,
     STRINGLIT,
+    CSTRINGLIT,
+#if FICL_WANT_USER
     USER, 
+#endif
     VARIABLE, 
 } WORDKIND;
+
 WORDKIND   ficlWordClassify(FICL_WORD *pFW);
 
 /*
@@ -1036,6 +1127,25 @@ extern void ficlPnphandlers(FICL_VM *pVM);
 extern void ficlCcall(FICL_VM *pVM);
 #endif
 
+/*
+** Used with File-Access wordset.
+*/
+#define FICL_FAM_READ	1
+#define FICL_FAM_WRITE	2
+#define FICL_FAM_APPEND	4
+#define FICL_FAM_BINARY	8
+
+#define FICL_FAM_OPEN_MODE(fam)	((fam) & (FICL_FAM_READ | FICL_FAM_WRITE | FICL_FAM_APPEND))
+
+
+#if (FICL_WANT_FILE)
+typedef struct ficlFILE
+{
+	FILE *f;
+	char filename[256];
+} ficlFILE;
+#endif
+
 #ifdef __cplusplus
 }
 #endif
diff --git a/sys/boot/ficl/fileaccess.c b/sys/boot/ficl/fileaccess.c
new file mode 100644
index 0000000..686c721
--- /dev/null
+++ b/sys/boot/ficl/fileaccess.c
@@ -0,0 +1,425 @@
+/* $FreeBSD$ */
+
+#include <errno.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <sys/stat.h>
+#include "ficl.h"
+
+#if FICL_WANT_FILE
+/*
+**
+** fileaccess.c
+**
+** Implements all of the File Access word set that can be implemented in portable C.
+**
+*/
+
+static void pushIor(FICL_VM *pVM, int success)
+{
+    int ior;
+    if (success)
+        ior = 0;
+    else
+        ior = errno;
+    stackPushINT(pVM->pStack, ior);
+}
+
+
+
+static void ficlFopen(FICL_VM *pVM, char *writeMode) /* ( c-addr u fam -- fileid ior ) */
+{
+    int fam = stackPopINT(pVM->pStack);
+    int length = stackPopINT(pVM->pStack);
+    void *address = (void *)stackPopPtr(pVM->pStack);
+    char mode[4];
+    FILE *f;
+
+    char *filename = (char *)alloca(length + 1);
+    memcpy(filename, address, length);
+    filename[length] = 0;
+
+    *mode = 0;
+
+    switch (FICL_FAM_OPEN_MODE(fam))
+        {
+        case 0:
+            stackPushPtr(pVM->pStack, NULL);
+            stackPushINT(pVM->pStack, EINVAL);
+            return;
+        case FICL_FAM_READ:
+            strcat(mode, "r");
+            break;
+        case FICL_FAM_WRITE:
+            strcat(mode, writeMode);
+            break;
+        case FICL_FAM_READ | FICL_FAM_WRITE:
+            strcat(mode, writeMode);
+            strcat(mode, "+");
+            break;
+        }
+
+    strcat(mode, (fam & FICL_FAM_BINARY) ? "b" : "t");
+
+    f = fopen(filename, mode);
+    if (f == NULL)
+        stackPushPtr(pVM->pStack, NULL);
+    else
+        {
+        ficlFILE *ff = (ficlFILE *)malloc(sizeof(ficlFILE));
+        strcpy(ff->filename, filename);
+        ff->f = f;
+        stackPushPtr(pVM->pStack, ff);
+
+        fseek(f, 0, SEEK_SET);
+        }
+    pushIor(pVM, f != NULL);
+}
+
+
+
+static void ficlOpenFile(FICL_VM *pVM) /* ( c-addr u fam -- fileid ior ) */
+{
+    ficlFopen(pVM, "a");
+}
+
+
+static void ficlCreateFile(FICL_VM *pVM) /* ( c-addr u fam -- fileid ior ) */
+{
+    ficlFopen(pVM, "w");
+}
+
+
+static int closeFiclFILE(ficlFILE *ff) /* ( fileid -- ior ) */
+{
+    FILE *f = ff->f;
+    free(ff);
+    return !fclose(f);
+}
+
+static void ficlCloseFile(FICL_VM *pVM) /* ( fileid -- ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    pushIor(pVM, closeFiclFILE(ff));
+}
+
+static void ficlDeleteFile(FICL_VM *pVM) /* ( c-addr u -- ior ) */
+{
+    int length = stackPopINT(pVM->pStack);
+    void *address = (void *)stackPopPtr(pVM->pStack);
+
+    char *filename = (char *)alloca(length + 1);
+    memcpy(filename, address, length);
+    filename[length] = 0;
+
+    pushIor(pVM, !unlink(filename));
+}
+
+static void ficlRenameFile(FICL_VM *pVM) /* ( c-addr1 u1 c-addr2 u2 -- ior ) */
+{
+    int length;
+    void *address;
+    char *from;
+    char *to;
+
+    length = stackPopINT(pVM->pStack);
+    address = (void *)stackPopPtr(pVM->pStack);
+    to = (char *)alloca(length + 1);
+    memcpy(to, address, length);
+    to[length] = 0;
+
+    length = stackPopINT(pVM->pStack);
+    address = (void *)stackPopPtr(pVM->pStack);
+
+    from = (char *)alloca(length + 1);
+    memcpy(from, address, length);
+    from[length] = 0;
+
+    pushIor(pVM, !rename(from, to));
+}
+
+static void ficlFileStatus(FICL_VM *pVM) /* ( c-addr u -- x ior ) */
+{
+    struct stat statbuf;
+
+    int length = stackPopINT(pVM->pStack);
+    void *address = (void *)stackPopPtr(pVM->pStack);
+
+    char *filename = (char *)alloca(length + 1);
+    memcpy(filename, address, length);
+    filename[length] = 0;
+
+    if (stat(filename, &statbuf) == 0)
+    {
+        /*
+        ** the "x" left on the stack is implementation-defined.
+        ** I push the file's access mode (readable, writeable, is directory, etc)
+        ** as defined by ANSI C.
+        */
+        stackPushINT(pVM->pStack, statbuf.st_mode);
+        stackPushINT(pVM->pStack, 0);
+    }
+    else
+    {
+        stackPushINT(pVM->pStack, -1);
+        stackPushINT(pVM->pStack, ENOENT);
+    }
+}
+
+
+static void ficlFilePosition(FICL_VM *pVM) /* ( fileid -- ud ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    long ud = ftell(ff->f);
+    stackPushINT(pVM->pStack, ud);
+    pushIor(pVM, ud != -1);
+}
+
+
+
+static long fileSize(FILE *f)
+{
+    struct stat statbuf;
+    statbuf.st_size = -1;
+    if (fstat(fileno(f), &statbuf) != 0)
+        return -1;
+    return statbuf.st_size;
+}
+
+
+
+static void ficlFileSize(FICL_VM *pVM) /* ( fileid -- ud ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    long ud = fileSize(ff->f);
+    stackPushINT(pVM->pStack, ud);
+    pushIor(pVM, ud != -1);
+}
+
+
+
+#define nLINEBUF 256
+static void ficlIncludeFile(FICL_VM *pVM) /* ( i*x fileid -- j*x ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    CELL id = pVM->sourceID;
+    int     result = VM_OUTOFTEXT;
+    long currentPosition, totalSize;
+    long size;
+    pVM->sourceID.p = (void *)ff;
+
+    currentPosition = ftell(ff->f);
+    totalSize = fileSize(ff->f);
+    size = totalSize - currentPosition;
+
+    if ((totalSize != -1) && (currentPosition != -1) && (size > 0))
+        {
+        char *buffer = (char *)malloc(size);
+        long got = fread(buffer, 1, size, ff->f);
+        if (got == size)
+            result = ficlExecC(pVM, buffer, size);
+        }
+
+#if 0
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    CELL id = pVM->sourceID;
+    char    cp[nLINEBUF];
+    int     nLine = 0;
+    int     keepGoing;
+    int     result;
+    pVM->sourceID.p = (void *)ff;
+
+    /* feed each line to ficlExec */
+    keepGoing = TRUE;
+    while (keepGoing && fgets(cp, nLINEBUF, ff->f))
+    {
+        int len = strlen(cp) - 1;
+
+        nLine++;
+        if (len <= 0)
+            continue;
+
+        if (cp[len] == '\n')
+            cp[len] = '\0';
+
+        result = ficlExec(pVM, cp);
+
+        switch (result)
+        {
+            case VM_OUTOFTEXT:
+            case VM_USEREXIT:
+                break;
+
+            default:
+                pVM->sourceID = id;
+                keepGoing = FALSE;
+                break; 
+        }
+    }
+#endif /* 0 */
+    /*
+    ** Pass an empty line with SOURCE-ID == -1 to flush
+    ** any pending REFILLs (as required by FILE wordset)
+    */
+    pVM->sourceID.i = -1;
+    ficlExec(pVM, "");
+
+    pVM->sourceID = id;
+    closeFiclFILE(ff);
+}
+
+
+
+static void ficlReadFile(FICL_VM *pVM) /* ( c-addr u1 fileid -- u2 ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    int length = stackPopINT(pVM->pStack);
+    void *address = (void *)stackPopPtr(pVM->pStack);
+    int result;
+
+    clearerr(ff->f);
+    result = fread(address, 1, length, ff->f);
+
+    stackPushINT(pVM->pStack, result);
+    pushIor(pVM, ferror(ff->f) == 0);
+}
+
+
+
+static void ficlReadLine(FICL_VM *pVM) /* ( c-addr u1 fileid -- u2 flag ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    int length = stackPopINT(pVM->pStack);
+    char *address = (char *)stackPopPtr(pVM->pStack);
+    int error;
+    int flag;
+
+    if (feof(ff->f))
+        {
+        stackPushINT(pVM->pStack, -1);
+        stackPushINT(pVM->pStack, 0);
+        stackPushINT(pVM->pStack, 0);
+        return;
+        }
+
+    clearerr(ff->f);
+    *address = 0;
+    fgets(address, length, ff->f);
+
+    error = ferror(ff->f);
+    if (error != 0)
+        {
+        stackPushINT(pVM->pStack, -1);
+        stackPushINT(pVM->pStack, 0);
+        stackPushINT(pVM->pStack, error);
+        return;
+        }
+
+    length = strlen(address);
+    flag = (length > 0);
+    if (length && ((address[length - 1] == '\r') || (address[length - 1] == '\n')))
+        length--;
+    
+    stackPushINT(pVM->pStack, length);
+    stackPushINT(pVM->pStack, flag);
+    stackPushINT(pVM->pStack, 0); /* ior */
+}
+
+
+
+static void ficlWriteFile(FICL_VM *pVM) /* ( c-addr u1 fileid -- ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    int length = stackPopINT(pVM->pStack);
+    void *address = (void *)stackPopPtr(pVM->pStack);
+
+    clearerr(ff->f);
+    fwrite(address, 1, length, ff->f);
+    pushIor(pVM, ferror(ff->f) == 0);
+}
+
+
+
+static void ficlWriteLine(FICL_VM *pVM) /* ( c-addr u1 fileid -- ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    size_t length = (size_t)stackPopINT(pVM->pStack);
+    void *address = (void *)stackPopPtr(pVM->pStack);
+
+    clearerr(ff->f);
+    if (fwrite(address, 1, length, ff->f) == length)
+        fwrite("\n", 1, 1, ff->f);
+    pushIor(pVM, ferror(ff->f) == 0);
+}
+
+
+
+static void ficlRepositionFile(FICL_VM *pVM) /* ( ud fileid -- ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    size_t ud = (size_t)stackPopINT(pVM->pStack);
+
+    pushIor(pVM, fseek(ff->f, ud, SEEK_SET) == 0);
+}
+
+
+
+static void ficlFlushFile(FICL_VM *pVM) /* ( fileid -- ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    pushIor(pVM, fflush(ff->f) == 0);
+}
+
+
+
+#if FICL_HAVE_FTRUNCATE
+
+static void ficlResizeFile(FICL_VM *pVM) /* ( ud fileid -- ior ) */
+{
+    ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
+    size_t ud = (size_t)stackPopINT(pVM->pStack);
+
+    pushIor(pVM, ftruncate(fileno(ff->f), ud) == 0);
+}
+
+#endif /* FICL_HAVE_FTRUNCATE */
+
+#endif /* FICL_WANT_FILE */
+
+
+
+void ficlCompileFile(FICL_SYSTEM *pSys)
+{
+#if FICL_WANT_FILE
+    FICL_DICT *dp = pSys->dp;
+    assert(dp);
+
+    dictAppendWord(dp, "create-file", ficlCreateFile,  FW_DEFAULT);
+    dictAppendWord(dp, "open-file", ficlOpenFile,  FW_DEFAULT);
+    dictAppendWord(dp, "close-file", ficlCloseFile,  FW_DEFAULT);
+    dictAppendWord(dp, "include-file", ficlIncludeFile,  FW_DEFAULT);
+    dictAppendWord(dp, "read-file", ficlReadFile,  FW_DEFAULT);
+    dictAppendWord(dp, "read-line", ficlReadLine,  FW_DEFAULT);
+    dictAppendWord(dp, "write-file", ficlWriteFile,  FW_DEFAULT);
+    dictAppendWord(dp, "write-line", ficlWriteLine,  FW_DEFAULT);
+    dictAppendWord(dp, "file-position", ficlFilePosition,  FW_DEFAULT);
+    dictAppendWord(dp, "file-size", ficlFileSize,  FW_DEFAULT);
+    dictAppendWord(dp, "reposition-file", ficlRepositionFile,  FW_DEFAULT);
+    dictAppendWord(dp, "file-status", ficlFileStatus,  FW_DEFAULT);
+    dictAppendWord(dp, "flush-file", ficlFlushFile,  FW_DEFAULT);
+
+    dictAppendWord(dp, "delete-file", ficlDeleteFile,  FW_DEFAULT);
+    dictAppendWord(dp, "rename-file", ficlRenameFile,  FW_DEFAULT);
+
+#ifdef FICL_HAVE_FTRUNCATE
+    dictAppendWord(dp, "resize-file", ficlResizeFile,  FW_DEFAULT);
+
+    ficlSetEnv(pSys, "file", FICL_TRUE);
+    ficlSetEnv(pSys, "file-ext", FICL_TRUE);
+#endif /* FICL_HAVE_FTRUNCATE */
+#else
+    &pSys;
+#endif /* FICL_WANT_FILE */
+}
diff --git a/sys/boot/ficl/float.c b/sys/boot/ficl/float.c
new file mode 100644
index 0000000..3fe8581
--- /dev/null
+++ b/sys/boot/ficl/float.c
@@ -0,0 +1,1064 @@
+/*******************************************************************
+** f l o a t . c
+** Forth Inspired Command Language
+** ANS Forth FLOAT word-set written in C
+** Author: Guy Carver & John Sadler (john_sadler@alum.mit.edu)
+** Created: Apr 2001
+** $Id: float.c,v 1.8 2001/12/05 07:21:34 jsadler Exp $
+*******************************************************************/
+/*
+** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
+** All rights reserved.
+**
+** Get the latest Ficl release at http://ficl.sourceforge.net
+**
+** 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, please
+** contact me by email at the address above.
+**
+** L I C E N S E  and  D I S C L A I M E R
+** 
+** Redistribution and use in source and binary forms, with or without
+** modification, are permitted provided that the following conditions
+** are met:
+** 1. Redistributions of source code must retain the above copyright
+**    notice, this list of conditions and the following disclaimer.
+** 2. Redistributions in binary form must reproduce the above copyright
+**    notice, this list of conditions and the following disclaimer in the
+**    documentation and/or other materials provided with the distribution.
+**
+** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+** ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+** SUCH DAMAGE.
+*/
+
+/* $FreeBSD$ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <math.h>
+#include "ficl.h"
+
+#if FICL_WANT_FLOAT
+
+/*******************************************************************
+** Do float addition r1 + r2.
+** f+ ( r1 r2 -- r )
+*******************************************************************/
+static void Fadd(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 1);
+#endif
+
+    f = POPFLOAT();
+    f += GETTOPF().f;
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do float subtraction r1 - r2.
+** f- ( r1 r2 -- r )
+*******************************************************************/
+static void Fsub(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 1);
+#endif
+
+    f = POPFLOAT();
+    f = GETTOPF().f - f;
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do float multiplication r1 * r2.
+** f* ( r1 r2 -- r )
+*******************************************************************/
+static void Fmul(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 1);
+#endif
+
+    f = POPFLOAT();
+    f *= GETTOPF().f;
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do float negation.
+** fnegate ( r -- r )
+*******************************************************************/
+static void Fnegate(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 1);
+#endif
+
+    f = -GETTOPF().f;
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do float division r1 / r2.
+** f/ ( r1 r2 -- r )
+*******************************************************************/
+static void Fdiv(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 1);
+#endif
+
+    f = POPFLOAT();
+    f = GETTOPF().f / f;
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do float + integer r + n.
+** f+i ( r n -- r )
+*******************************************************************/
+static void Faddi(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 1);
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    f = (FICL_FLOAT)POPINT();
+    f += GETTOPF().f;
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do float - integer r - n.
+** f-i ( r n -- r )
+*******************************************************************/
+static void Fsubi(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 1);
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    f = GETTOPF().f;
+    f -= (FICL_FLOAT)POPINT();
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do float * integer r * n.
+** f*i ( r n -- r )
+*******************************************************************/
+static void Fmuli(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 1);
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    f = (FICL_FLOAT)POPINT();
+    f *= GETTOPF().f;
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do float / integer r / n.
+** f/i ( r n -- r )
+*******************************************************************/
+static void Fdivi(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 1);
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    f = GETTOPF().f;
+    f /= (FICL_FLOAT)POPINT();
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do integer - float n - r.
+** i-f ( n r -- r )
+*******************************************************************/
+static void isubf(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 1);
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    f = (FICL_FLOAT)POPINT();
+    f -= GETTOPF().f;
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do integer / float n / r.
+** i/f ( n r -- r )
+*******************************************************************/
+static void idivf(FICL_VM *pVM)
+{
+    FICL_FLOAT f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1,1);
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    f = (FICL_FLOAT)POPINT();
+    f /= GETTOPF().f;
+    SETTOPF(f);
+}
+
+/*******************************************************************
+** Do integer to float conversion.
+** int>float ( n -- r )
+*******************************************************************/
+static void itof(FICL_VM *pVM)
+{
+    float f;
+
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+    vmCheckFStack(pVM, 0, 1);
+#endif
+
+    f = (float)POPINT();
+    PUSHFLOAT(f);
+}
+
+/*******************************************************************
+** Do float to integer conversion.
+** float>int ( r -- n )
+*******************************************************************/
+static void Ftoi(FICL_VM *pVM)
+{
+    FICL_INT i;
+
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 0, 1);
+    vmCheckFStack(pVM, 1, 0);
+#endif
+
+    i = (FICL_INT)POPFLOAT();
+    PUSHINT(i);
+}
+
+/*******************************************************************
+** Floating point constant execution word.
+*******************************************************************/
+void FconstantParen(FICL_VM *pVM)
+{
+    FICL_WORD *pFW = pVM->runningWord;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 0, 1);
+#endif
+
+    PUSHFLOAT(pFW->param[0].f);
+}
+
+/*******************************************************************
+** Create a floating point constant.
+** fconstant ( r -"name"- )
+*******************************************************************/
+static void Fconstant(FICL_VM *pVM)
+{
+    FICL_DICT *dp = vmGetDict(pVM);
+    STRINGINFO si = vmGetWord(pVM);
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);
+#endif
+
+    dictAppendWord2(dp, si, FconstantParen, FW_DEFAULT);
+    dictAppendCell(dp, stackPop(pVM->fStack));
+}
+
+/*******************************************************************
+** Display a float in decimal format.
+** f. ( r -- )
+*******************************************************************/
+static void FDot(FICL_VM *pVM)
+{
+    float f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);
+#endif
+
+    f = POPFLOAT();
+    sprintf(pVM->pad,"%#f ",f);
+    vmTextOut(pVM, pVM->pad, 0);
+}
+
+/*******************************************************************
+** Display a float in engineering format.
+** fe. ( r -- )
+*******************************************************************/
+static void EDot(FICL_VM *pVM)
+{
+    float f;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);
+#endif
+
+    f = POPFLOAT();
+    sprintf(pVM->pad,"%#e ",f);
+    vmTextOut(pVM, pVM->pad, 0);
+}
+
+/**************************************************************************
+                        d i s p l a y FS t a c k
+** Display the parameter stack (code for "f.s")
+** f.s ( -- )
+**************************************************************************/
+static void displayFStack(FICL_VM *pVM)
+{
+    int d = stackDepth(pVM->fStack);
+    int i;
+    CELL *pCell;
+
+    vmCheckFStack(pVM, 0, 0);
+
+    vmTextOut(pVM, "F:", 0);
+
+    if (d == 0)
+        vmTextOut(pVM, "[0]", 0);
+    else
+    {
+        ltoa(d, &pVM->pad[1], pVM->base);
+        pVM->pad[0] = '[';
+        strcat(pVM->pad,"] ");
+        vmTextOut(pVM,pVM->pad,0);
+
+        pCell = pVM->fStack->sp - d;
+        for (i = 0; i < d; i++)
+        {
+            sprintf(pVM->pad,"%#f ",(*pCell++).f);
+            vmTextOut(pVM,pVM->pad,0);
+        }
+    }
+}
+
+/*******************************************************************
+** Do float stack depth.
+** fdepth ( -- n )
+*******************************************************************/
+static void Fdepth(FICL_VM *pVM)
+{
+    int i;
+
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 0, 1);
+#endif
+
+    i = stackDepth(pVM->fStack);
+    PUSHINT(i);
+}
+
+/*******************************************************************
+** Do float stack drop.
+** fdrop ( r -- )
+*******************************************************************/
+static void Fdrop(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);
+#endif
+
+    DROPF(1);
+}
+
+/*******************************************************************
+** Do float stack 2drop.
+** f2drop ( r r -- )
+*******************************************************************/
+static void FtwoDrop(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 0);
+#endif
+
+    DROPF(2);
+}
+
+/*******************************************************************
+** Do float stack dup.
+** fdup ( r -- r r )
+*******************************************************************/
+static void Fdup(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 2);
+#endif
+
+    PICKF(0);
+}
+
+/*******************************************************************
+** Do float stack 2dup.
+** f2dup ( r1 r2 -- r1 r2 r1 r2 )
+*******************************************************************/
+static void FtwoDup(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 4);
+#endif
+
+    PICKF(1);
+    PICKF(1);
+}
+
+/*******************************************************************
+** Do float stack over.
+** fover ( r1 r2 -- r1 r2 r1 )
+*******************************************************************/
+static void Fover(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 3);
+#endif
+
+    PICKF(1);
+}
+
+/*******************************************************************
+** Do float stack 2over.
+** f2over ( r1 r2 r3 -- r1 r2 r3 r1 r2 )
+*******************************************************************/
+static void FtwoOver(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 4, 6);
+#endif
+
+    PICKF(3);
+    PICKF(3);
+}
+
+/*******************************************************************
+** Do float stack pick.
+** fpick ( n -- r )
+*******************************************************************/
+static void Fpick(FICL_VM *pVM)
+{
+    CELL c = POP();
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, c.i+1, c.i+2);
+#endif
+
+    PICKF(c.i);
+}
+
+/*******************************************************************
+** Do float stack ?dup.
+** f?dup ( r -- r )
+*******************************************************************/
+static void FquestionDup(FICL_VM *pVM)
+{
+    CELL c;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 2);
+#endif
+
+    c = GETTOPF();
+    if (c.f != 0)
+        PICKF(0);
+}
+
+/*******************************************************************
+** Do float stack roll.
+** froll ( n -- )
+*******************************************************************/
+static void Froll(FICL_VM *pVM)
+{
+    int i = POP().i;
+    i = (i > 0) ? i : 0;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, i+1, i+1);
+#endif
+
+    ROLLF(i);
+}
+
+/*******************************************************************
+** Do float stack -roll.
+** f-roll ( n -- )
+*******************************************************************/
+static void FminusRoll(FICL_VM *pVM)
+{
+    int i = POP().i;
+    i = (i > 0) ? i : 0;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, i+1, i+1);
+#endif
+
+    ROLLF(-i);
+}
+
+/*******************************************************************
+** Do float stack rot.
+** frot ( r1 r2 r3  -- r2 r3 r1 )
+*******************************************************************/
+static void Frot(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 3, 3);
+#endif
+
+    ROLLF(2);
+}
+
+/*******************************************************************
+** Do float stack -rot.
+** f-rot ( r1 r2 r3  -- r3 r1 r2 )
+*******************************************************************/
+static void Fminusrot(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 3, 3);
+#endif
+
+    ROLLF(-2);
+}
+
+/*******************************************************************
+** Do float stack swap.
+** fswap ( r1 r2 -- r2 r1 )
+*******************************************************************/
+static void Fswap(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 2);
+#endif
+
+    ROLLF(1);
+}
+
+/*******************************************************************
+** Do float stack 2swap
+** f2swap ( r1 r2 r3 r4  -- r3 r4 r1 r2 )
+*******************************************************************/
+static void FtwoSwap(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 4, 4);
+#endif
+
+    ROLLF(3);
+    ROLLF(3);
+}
+
+/*******************************************************************
+** Get a floating point number from a variable.
+** f@ ( n -- r )
+*******************************************************************/
+static void Ffetch(FICL_VM *pVM)
+{
+    CELL *pCell;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 0, 1);
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    pCell = (CELL *)POPPTR();
+    PUSHFLOAT(pCell->f);
+}
+
+/*******************************************************************
+** Store a floating point number into a variable.
+** f! ( r n -- )
+*******************************************************************/
+static void Fstore(FICL_VM *pVM)
+{
+    CELL *pCell;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    pCell = (CELL *)POPPTR();
+    pCell->f = POPFLOAT();
+}
+
+/*******************************************************************
+** Add a floating point number to contents of a variable.
+** f+! ( r n -- )
+*******************************************************************/
+static void FplusStore(FICL_VM *pVM)
+{
+    CELL *pCell;
+
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 1, 0);
+    vmCheckFStack(pVM, 1, 0);
+#endif
+
+    pCell = (CELL *)POPPTR();
+    pCell->f += POPFLOAT();
+}
+
+/*******************************************************************
+** Floating point literal execution word.
+*******************************************************************/
+static void fliteralParen(FICL_VM *pVM)
+{
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM, 0, 1);
+#endif
+
+    PUSHFLOAT(*(float*)(pVM->ip));
+    vmBranchRelative(pVM, 1);
+}
+
+/*******************************************************************
+** Compile a floating point literal.
+*******************************************************************/
+static void fliteralIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = vmGetDict(pVM);
+    FICL_WORD *pfLitParen = ficlLookup(pVM->pSys, "(fliteral)");
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);
+#endif
+
+    dictAppendCell(dp, LVALUEtoCELL(pfLitParen));
+    dictAppendCell(dp, stackPop(pVM->fStack));
+}
+
+/*******************************************************************
+** Do float 0= comparison r = 0.0.
+** f0= ( r -- T/F )
+*******************************************************************/
+static void FzeroEquals(FICL_VM *pVM)
+{
+    CELL c;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);                   /* Make sure something on float stack. */
+    vmCheckStack(pVM, 0, 1);                    /* Make sure room for result. */
+#endif
+
+    c.i = FICL_BOOL(POPFLOAT() == 0);
+    PUSH(c);
+}
+
+/*******************************************************************
+** Do float 0< comparison r < 0.0.
+** f0< ( r -- T/F )
+*******************************************************************/
+static void FzeroLess(FICL_VM *pVM)
+{
+    CELL c;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);                   /* Make sure something on float stack. */
+    vmCheckStack(pVM, 0, 1);                    /* Make sure room for result. */
+#endif
+
+    c.i = FICL_BOOL(POPFLOAT() < 0);
+    PUSH(c);
+}
+
+/*******************************************************************
+** Do float 0> comparison r > 0.0.
+** f0> ( r -- T/F )
+*******************************************************************/
+static void FzeroGreater(FICL_VM *pVM)
+{
+    CELL c;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);
+    vmCheckStack(pVM, 0, 1);
+#endif
+
+    c.i = FICL_BOOL(POPFLOAT() > 0);
+    PUSH(c);
+}
+
+/*******************************************************************
+** Do float = comparison r1 = r2.
+** f= ( r1 r2 -- T/F )
+*******************************************************************/
+static void FisEqual(FICL_VM *pVM)
+{
+    float x, y;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 0);
+    vmCheckStack(pVM, 0, 1);
+#endif
+
+    x = POPFLOAT();
+    y = POPFLOAT();
+    PUSHINT(FICL_BOOL(x == y));
+}
+
+/*******************************************************************
+** Do float < comparison r1 < r2.
+** f< ( r1 r2 -- T/F )
+*******************************************************************/
+static void FisLess(FICL_VM *pVM)
+{
+    float x, y;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 0);
+    vmCheckStack(pVM, 0, 1);
+#endif
+
+    y = POPFLOAT();
+    x = POPFLOAT();
+    PUSHINT(FICL_BOOL(x < y));
+}
+
+/*******************************************************************
+** Do float > comparison r1 > r2.
+** f> ( r1 r2 -- T/F )
+*******************************************************************/
+static void FisGreater(FICL_VM *pVM)
+{
+    float x, y;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 2, 0);
+    vmCheckStack(pVM, 0, 1);
+#endif
+
+    y = POPFLOAT();
+    x = POPFLOAT();
+    PUSHINT(FICL_BOOL(x > y));
+}
+
+
+/*******************************************************************
+** Move float to param stack (assumes they both fit in a single CELL)
+** f>s 
+*******************************************************************/
+static void FFrom(FICL_VM *pVM)
+{
+    CELL c;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 1, 0);
+    vmCheckStack(pVM, 0, 1);
+#endif
+
+    c = stackPop(pVM->fStack);
+    stackPush(pVM->pStack, c);
+    return;
+}
+
+static void ToF(FICL_VM *pVM)
+{
+    CELL c;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 0, 1);
+    vmCheckStack(pVM, 1, 0);
+#endif
+
+    c = stackPop(pVM->pStack);
+    stackPush(pVM->fStack, c);
+    return;
+}
+
+
+/**************************************************************************
+                     F l o a t P a r s e S t a t e
+** Enum to determine the current segement of a floating point number
+** being parsed.
+**************************************************************************/
+#define NUMISNEG 1
+#define EXPISNEG 2
+
+typedef enum _floatParseState
+{
+    FPS_START,
+    FPS_ININT,
+    FPS_INMANT,
+    FPS_STARTEXP,
+    FPS_INEXP
+} FloatParseState;
+
+/**************************************************************************
+                     f i c l P a r s e F l o a t N u m b e r
+** pVM -- Virtual Machine pointer.
+** si -- String to parse.
+** Returns 1 if successful, 0 if not.
+**************************************************************************/
+int ficlParseFloatNumber( FICL_VM *pVM, STRINGINFO si )
+{
+    unsigned char ch, digit;
+    char *cp;
+    FICL_COUNT count;
+    float power;
+    float accum = 0.0f;
+    float mant = 0.1f;
+    FICL_INT exponent = 0;
+    char flag = 0;
+    FloatParseState estate = FPS_START;
+
+#if FICL_ROBUST > 1
+    vmCheckFStack(pVM, 0, 1);
+#endif
+
+    /*
+    ** floating point numbers only allowed in base 10 
+    */
+    if (pVM->base != 10)
+        return(0);
+
+
+    cp = SI_PTR(si);
+    count = (FICL_COUNT)SI_COUNT(si);
+
+    /* Loop through the string's characters. */
+    while ((count--) && ((ch = *cp++) != 0))
+    {
+        switch (estate)
+        {
+            /* At start of the number so look for a sign. */
+            case FPS_START:
+            {
+                estate = FPS_ININT;
+                if (ch == '-')
+                {
+                    flag |= NUMISNEG;
+                    break;
+                }
+                if (ch == '+')
+                {
+                    break;
+                }
+            } /* Note!  Drop through to FPS_ININT */
+            /*
+            **Converting integer part of number.
+            ** Only allow digits, decimal and 'E'. 
+            */
+            case FPS_ININT:
+            {
+                if (ch == '.')
+                {
+                    estate = FPS_INMANT;
+                }
+                else if ((ch == 'e') || (ch == 'E'))
+                {
+                    estate = FPS_STARTEXP;
+                }
+                else
+                {
+                    digit = (unsigned char)(ch - '0');
+                    if (digit > 9)
+                        return(0);
+
+                    accum = accum * 10 + digit;
+
+                }
+                break;
+            }
+            /*
+            ** Processing the fraction part of number.
+            ** Only allow digits and 'E' 
+            */
+            case FPS_INMANT:
+            {
+                if ((ch == 'e') || (ch == 'E'))
+                {
+                    estate = FPS_STARTEXP;
+                }
+                else
+                {
+                    digit = (unsigned char)(ch - '0');
+                    if (digit > 9)
+                        return(0);
+
+                    accum += digit * mant;
+                    mant *= 0.1f;
+                }
+                break;
+            }
+            /* Start processing the exponent part of number. */
+            /* Look for sign. */
+            case FPS_STARTEXP:
+            {
+                estate = FPS_INEXP;
+
+                if (ch == '-')
+                {
+                    flag |= EXPISNEG;
+                    break;
+                }
+                else if (ch == '+')
+                {
+                    break;
+                }
+            }       /* Note!  Drop through to FPS_INEXP */
+            /*
+            ** Processing the exponent part of number.
+            ** Only allow digits. 
+            */
+            case FPS_INEXP:
+            {
+                digit = (unsigned char)(ch - '0');
+                if (digit > 9)
+                    return(0);
+
+                exponent = exponent * 10 + digit;
+
+                break;
+            }
+        }
+    }
+
+    /* If parser never made it to the exponent this is not a float. */
+    if (estate < FPS_STARTEXP)
+        return(0);
+
+    /* Set the sign of the number. */
+    if (flag & NUMISNEG)
+        accum = -accum;
+
+    /* If exponent is not 0 then adjust number by it. */
+    if (exponent != 0)
+    {
+        /* Determine if exponent is negative. */
+        if (flag & EXPISNEG)
+        {
+            exponent = -exponent;
+        }
+        /* power = 10^x */
+        power = (float)pow(10.0, exponent);
+        accum *= power;
+    }
+
+    PUSHFLOAT(accum);
+
+    return(1);
+}
+
+#endif  /* FICL_WANT_FLOAT */
+
+/**************************************************************************
+** Add float words to a system's dictionary.
+** pSys -- Pointer to the FICL sytem to add float words to.
+**************************************************************************/
+void ficlCompileFloat(FICL_SYSTEM *pSys)
+{
+    FICL_DICT *dp = pSys->dp;
+    assert(dp);
+
+#if FICL_WANT_FLOAT
+    dictAppendWord(dp, ">float",    ToF,            FW_DEFAULT);
+    /* d>f */
+    dictAppendWord(dp, "f!",        Fstore,         FW_DEFAULT);
+    dictAppendWord(dp, "f*",        Fmul,           FW_DEFAULT);
+    dictAppendWord(dp, "f+",        Fadd,           FW_DEFAULT);
+    dictAppendWord(dp, "f-",        Fsub,           FW_DEFAULT);
+    dictAppendWord(dp, "f/",        Fdiv,           FW_DEFAULT);
+    dictAppendWord(dp, "f0<",       FzeroLess,      FW_DEFAULT);
+    dictAppendWord(dp, "f0=",       FzeroEquals,    FW_DEFAULT);
+    dictAppendWord(dp, "f<",        FisLess,        FW_DEFAULT);
+ /* 
+    f>d 
+ */
+    dictAppendWord(dp, "f@",        Ffetch,         FW_DEFAULT);
+ /* 
+    falign 
+    faligned 
+ */
+    dictAppendWord(dp, "fconstant", Fconstant,      FW_DEFAULT);
+    dictAppendWord(dp, "fdepth",    Fdepth,         FW_DEFAULT);
+    dictAppendWord(dp, "fdrop",     Fdrop,          FW_DEFAULT);
+    dictAppendWord(dp, "fdup",      Fdup,           FW_DEFAULT);
+    dictAppendWord(dp, "fliteral",  fliteralIm,     FW_IMMEDIATE);
+/*
+    float+
+    floats
+    floor
+    fmax
+    fmin
+*/
+    dictAppendWord(dp, "f?dup",     FquestionDup,   FW_DEFAULT);
+    dictAppendWord(dp, "f=",        FisEqual,       FW_DEFAULT);
+    dictAppendWord(dp, "f>",        FisGreater,     FW_DEFAULT);
+    dictAppendWord(dp, "f0>",       FzeroGreater,   FW_DEFAULT);
+    dictAppendWord(dp, "f2drop",    FtwoDrop,       FW_DEFAULT);
+    dictAppendWord(dp, "f2dup",     FtwoDup,        FW_DEFAULT);
+    dictAppendWord(dp, "f2over",    FtwoOver,       FW_DEFAULT);
+    dictAppendWord(dp, "f2swap",    FtwoSwap,       FW_DEFAULT);
+    dictAppendWord(dp, "f+!",       FplusStore,     FW_DEFAULT);
+    dictAppendWord(dp, "f+i",       Faddi,          FW_DEFAULT);
+    dictAppendWord(dp, "f-i",       Fsubi,          FW_DEFAULT);
+    dictAppendWord(dp, "f*i",       Fmuli,          FW_DEFAULT);
+    dictAppendWord(dp, "f/i",       Fdivi,          FW_DEFAULT);
+    dictAppendWord(dp, "int>float", itof,           FW_DEFAULT);
+    dictAppendWord(dp, "float>int", Ftoi,           FW_DEFAULT);
+    dictAppendWord(dp, "f.",        FDot,           FW_DEFAULT);
+    dictAppendWord(dp, "f.s",       displayFStack,  FW_DEFAULT);
+    dictAppendWord(dp, "fe.",       EDot,           FW_DEFAULT);
+    dictAppendWord(dp, "fover",     Fover,          FW_DEFAULT);
+    dictAppendWord(dp, "fnegate",   Fnegate,        FW_DEFAULT);
+    dictAppendWord(dp, "fpick",     Fpick,          FW_DEFAULT);
+    dictAppendWord(dp, "froll",     Froll,          FW_DEFAULT);
+    dictAppendWord(dp, "frot",      Frot,           FW_DEFAULT);
+    dictAppendWord(dp, "fswap",     Fswap,          FW_DEFAULT);
+    dictAppendWord(dp, "i-f",       isubf,          FW_DEFAULT);
+    dictAppendWord(dp, "i/f",       idivf,          FW_DEFAULT);
+
+    dictAppendWord(dp, "float>",    FFrom,          FW_DEFAULT);
+
+    dictAppendWord(dp, "f-roll",    FminusRoll,     FW_DEFAULT);
+    dictAppendWord(dp, "f-rot",     Fminusrot,      FW_DEFAULT);
+    dictAppendWord(dp, "(fliteral)", fliteralParen, FW_COMPILE);
+
+    ficlSetEnv(pSys, "floating",       FICL_FALSE);  /* not all required words are present */
+    ficlSetEnv(pSys, "floating-ext",   FICL_FALSE);
+    ficlSetEnv(pSys, "floating-stack", FICL_DEFAULT_STACK);
+#endif
+    return;
+}
diff --git a/sys/boot/ficl/i386/sysdep.h b/sys/boot/ficl/i386/sysdep.h
index b44fbc4..b3f896e 100644
--- a/sys/boot/ficl/i386/sysdep.h
+++ b/sys/boot/ficl/i386/sysdep.h
@@ -9,7 +9,7 @@
 ** FICL_ROBUST is enabled. This may require some consideration
 ** in firmware systems since assert often
 ** assumes stderr/stdout.  
-** $Id: sysdep.h,v 1.6 2001-04-26 21:41:55-07 jsadler Exp jsadler $
+** $Id: sysdep.h,v 1.11 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -17,6 +17,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -39,13 +44,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: sysdep.h,v 1.6 2001-04-26 21:41:55-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
@@ -75,7 +73,6 @@
 #define FALSE 0
 #endif
 
-
 /*
 ** System dependent data type declarations...
 */
@@ -162,6 +159,7 @@ typedef struct
 #endif
 #if (FICL_MINIMAL)
 #define FICL_WANT_SOFTWORDS  0
+#define FICL_WANT_FILE       0
 #define FICL_WANT_FLOAT      0
 #define FICL_WANT_USER       0
 #define FICL_WANT_LOCALS     0
@@ -181,6 +179,17 @@ typedef struct
 #define FICL_PLATFORM_EXTEND 1
 #endif
 
+
+/*
+** FICL_WANT_FILE
+** Includes the FILE and FILE-EXT wordset and associated code. Turn this off if you do not
+** have a file system!
+** Contributed by Larry Hastings
+*/
+#if !defined (FICL_WANT_FILE)
+#define FICL_WANT_FILE 0
+#endif
+
 /*
 ** FICL_WANT_FLOAT
 ** Includes a floating point stack for the VM, and words to do float operations.
@@ -199,6 +208,14 @@ typedef struct
 #endif
 
 /*
+** FICL_EXTENDED_PREFIX enables a bunch of extra prefixes in prefix.c and prefix.fr (if
+** included as part of softcore.c)
+*/
+#if !defined FICL_EXTENDED_PREFIX
+#define FICL_EXTENDED_PREFIX 0
+#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
@@ -341,14 +358,6 @@ typedef struct
 #endif
 
 /*
-** FICL_EXTENDED_PREFIX enables a bunch of extra prefixes in prefix.c and prefix.fr (if
-** included as part of softcore.c)
-*/
-#if !defined FICL_EXTENDED_PREFIX
-#define FICL_EXTENDED_PREFIX 0
-#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
@@ -409,4 +418,15 @@ int ficlLockDictionary(short fLock);
 DPUNS ficlLongMul(FICL_UNS x, FICL_UNS y);
 UNSQR ficlLongDiv(DPUNS    q, FICL_UNS y);
 
+
+/*
+** FICL_HAVE_FTRUNCATE indicates whether the current OS supports
+** the ftruncate() function (available on most UNIXes).  This
+** function is necessary to provide the complete File-Access wordset.
+*/
+#if !defined (FICL_HAVE_FTRUNCATE)
+#define FICL_HAVE_FTRUNCATE 0
+#endif
+
+
 #endif /*__SYSDEP_H__*/
diff --git a/sys/boot/ficl/ia64/sysdep.h b/sys/boot/ficl/ia64/sysdep.h
index 0a6ca33..d0e5a2f 100644
--- a/sys/boot/ficl/ia64/sysdep.h
+++ b/sys/boot/ficl/ia64/sysdep.h
@@ -9,7 +9,7 @@
 ** FICL_ROBUST is enabled. This may require some consideration
 ** in firmware systems since assert often
 ** assumes stderr/stdout.  
-** $Id: sysdep.h,v 1.6 2001-04-26 21:41:55-07 jsadler Exp jsadler $
+** $Id: sysdep.h,v 1.11 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -17,6 +17,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -40,11 +45,6 @@
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
 **
-** 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, please send
-** contact me by email at the address above.
-**
 ** $Id: sysdep.h,v 1.6 2001-04-26 21:41:55-07 jsadler Exp jsadler $
 */
 
@@ -75,7 +75,6 @@
 #define FALSE 0
 #endif
 
-
 /*
 ** System dependent data type declarations...
 */
@@ -162,6 +161,7 @@ typedef struct
 #endif
 #if (FICL_MINIMAL)
 #define FICL_WANT_SOFTWORDS  0
+#define FICL_WANT_FILE       0
 #define FICL_WANT_FLOAT      0
 #define FICL_WANT_USER       0
 #define FICL_WANT_LOCALS     0
@@ -181,6 +181,17 @@ typedef struct
 #define FICL_PLATFORM_EXTEND 1
 #endif
 
+
+/*
+** FICL_WANT_FILE
+** Includes the FILE and FILE-EXT wordset and associated code. Turn this off if you do not
+** have a file system!
+** Contributed by Larry Hastings
+*/
+#if !defined (FICL_WANT_FILE)
+#define FICL_WANT_FILE 0
+#endif
+
 /*
 ** FICL_WANT_FLOAT
 ** Includes a floating point stack for the VM, and words to do float operations.
@@ -199,6 +210,14 @@ typedef struct
 #endif
 
 /*
+** FICL_EXTENDED_PREFIX enables a bunch of extra prefixes in prefix.c and prefix.fr (if
+** included as part of softcore.c)
+*/
+#if !defined FICL_EXTENDED_PREFIX
+#define FICL_EXTENDED_PREFIX 0
+#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
@@ -341,14 +360,6 @@ typedef struct
 #endif
 
 /*
-** FICL_EXTENDED_PREFIX enables a bunch of extra prefixes in prefix.c and prefix.fr (if
-** included as part of softcore.c)
-*/
-#if !defined FICL_EXTENDED_PREFIX
-#define FICL_EXTENDED_PREFIX 0
-#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
@@ -409,4 +420,15 @@ int ficlLockDictionary(short fLock);
 DPUNS ficlLongMul(FICL_UNS x, FICL_UNS y);
 UNSQR ficlLongDiv(DPUNS    q, FICL_UNS y);
 
+
+/*
+** FICL_HAVE_FTRUNCATE indicates whether the current OS supports
+** the ftruncate() function (available on most UNIXes).  This
+** function is necessary to provide the complete File-Access wordset.
+*/
+#if !defined (FICL_HAVE_FTRUNCATE)
+#define FICL_HAVE_FTRUNCATE 0
+#endif
+
+
 #endif /*__SYSDEP_H__*/
diff --git a/sys/boot/ficl/loader.c b/sys/boot/ficl/loader.c
index 54380b2..7aa8e3ae 100644
--- a/sys/boot/ficl/loader.c
+++ b/sys/boot/ficl/loader.c
@@ -591,7 +591,7 @@ static void fkey(FICL_VM *pVM)
 
 static void freeHeap(FICL_VM *pVM)
 {
-    stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict()));
+    stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
 }
 
 
@@ -653,17 +653,17 @@ void ficlCompilePlatform(FICL_SYSTEM *pSys)
 #endif
 
 #if defined(__i386__)
-    ficlSetEnv("arch-i386",         FICL_TRUE);
-    ficlSetEnv("arch-alpha",        FICL_FALSE);
-    ficlSetEnv("arch-ia64",         FICL_FALSE);
+    ficlSetEnv(pSys, "arch-i386",         FICL_TRUE);
+    ficlSetEnv(pSys, "arch-alpha",        FICL_FALSE);
+    ficlSetEnv(pSys, "arch-ia64",         FICL_FALSE);
 #elif defined(__alpha__)
-    ficlSetEnv("arch-i386",         FICL_FALSE);
-    ficlSetEnv("arch-alpha",        FICL_TRUE);
-    ficlSetEnv("arch-ia64",         FICL_FALSE);
+    ficlSetEnv(pSys, "arch-i386",         FICL_FALSE);
+    ficlSetEnv(pSys, "arch-alpha",        FICL_TRUE);
+    ficlSetEnv(pSys, "arch-ia64",         FICL_FALSE);
 #elif defined(__ia64__)
-    ficlSetEnv("arch-i386",         FICL_FALSE);
-    ficlSetEnv("arch-alpha",        FICL_FALSE);
-    ficlSetEnv("arch-ia64",         FICL_TRUE);
+    ficlSetEnv(pSys, "arch-i386",         FICL_FALSE);
+    ficlSetEnv(pSys, "arch-alpha",        FICL_FALSE);
+    ficlSetEnv(pSys, "arch-ia64",         FICL_TRUE);
 #endif
 
     return;
diff --git a/sys/boot/ficl/math64.c b/sys/boot/ficl/math64.c
index a355883..6e50458 100644
--- a/sys/boot/ficl/math64.c
+++ b/sys/boot/ficl/math64.c
@@ -5,7 +5,7 @@
 ** Created: 25 January 1998
 ** Rev 2.03: Support for 128 bit DP math. This file really ouught to
 ** be renamed!
-** $Id: math64.c,v 1.5 2001-04-26 21:41:36-07 jsadler Exp jsadler $
+** $Id: math64.c,v 1.9 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -13,6 +13,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -35,13 +40,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: math64.c,v 1.5 2001-04-26 21:41:36-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
diff --git a/sys/boot/ficl/math64.h b/sys/boot/ficl/math64.h
index 8fd1517..a4e5636 100644
--- a/sys/boot/ficl/math64.h
+++ b/sys/boot/ficl/math64.h
@@ -3,12 +3,17 @@
 ** Forth Inspired Command Language - 64 bit math support routines
 ** Author: John Sadler (john_sadler@alum.mit.edu)
 ** Created: 25 January 1998
-** $Id: math64.h,v 1.5 2001-04-26 21:41:53-07 jsadler Exp jsadler $
+** $Id: math64.h,v 1.9 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
 ** All rights reserved.
 **
+** 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, please 
+** contact me by email at the address above.
+**
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
 ** L I C E N S E  and  D I S C L A I M E R
@@ -33,13 +38,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: math64.h,v 1.5 2001-04-26 21:41:53-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
diff --git a/sys/boot/ficl/prefix.c b/sys/boot/ficl/prefix.c
index 0d52b7c..447f740 100644
--- a/sys/boot/ficl/prefix.c
+++ b/sys/boot/ficl/prefix.c
@@ -4,7 +4,7 @@
 ** Parser extensions for Ficl
 ** Authors: Larry Hastings & John Sadler (john_sadler@alum.mit.edu)
 ** Created: April 2001
-** $Id: prefix.c,v 1.1 2001-04-26 21:41:33-07 jsadler Exp jsadler $
+** $Id: prefix.c,v 1.6 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -12,6 +12,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -34,13 +39,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: prefix.c,v 1.1 2001-04-26 21:41:33-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
@@ -76,9 +74,15 @@ int ficlParsePrefix(FICL_VM *pVM, STRINGINFO si)
 {
     int i;
     FICL_HASH *pHash;
-    FICL_WORD *pFW = ficlLookup(list_name);
+    FICL_WORD *pFW = ficlLookup(pVM->pSys, list_name);
+
+    /* 
+    ** Make sure we found the prefix dictionary - otherwise silently fail
+    ** If forth-wordlist is not in the search order, we won't find the prefixes.
+    */
+    if (!pFW)
+        return FICL_FALSE;
 
-    assert(pFW);
     pHash = (FICL_HASH *)(pFW->param[0].p);
     /*
     ** Walk the list looking for a match with the beginning of the incoming token
@@ -96,7 +100,8 @@ int ficlParsePrefix(FICL_VM *pVM, STRINGINFO si)
             */
             if (!strincmp(SI_PTR(si), pFW->name, (FICL_UNS)n))
             {
-                vmSetTibIndex(pVM, vmGetTibIndex(pVM) - 1 - SI_COUNT(si) + n);
+                /* (sadler) fixed off-by-one error when the token has no trailing space in the TIB */
+				vmSetTibIndex(pVM, si.cp + n - pVM->tib.cp );
                 vmExecute(pVM, pFW);
 
                 return FICL_TRUE;
@@ -118,7 +123,7 @@ static void tempBase(FICL_VM *pVM, int base)
     if (!ficlParseNumber(pVM, si)) 
     {
         int i = SI_COUNT(si);
-        vmThrowErr(pVM, "0x%.*s is not a valid hex value", i, SI_PTR(si));
+        vmThrowErr(pVM, "%.*s not recognized", i, SI_PTR(si));
     }
 
     pVM->base = oldbase;
@@ -168,6 +173,10 @@ void ficlCompilePrefix(FICL_SYSTEM *pSys)
     pHash->name = list_name;
     dictAppendWord(dp, list_name, constantParen, FW_DEFAULT);
     dictAppendCell(dp, LVALUEtoCELL(pHash));
+
+	/*
+	** Put __tempbase in the forth-wordlist
+	*/
     dictAppendWord(dp, "__tempbase", fTempBase, FW_DEFAULT);
 
     /*
@@ -178,7 +187,7 @@ void ficlCompilePrefix(FICL_SYSTEM *pSys)
     dictAppendWord(dp, "0x", prefixHex, FW_DEFAULT);
     dictAppendWord(dp, "0d", prefixTen, FW_DEFAULT);
 #if (FICL_EXTENDED_PREFIX)
-    pFW = ficlLookup("\\");
+    pFW = ficlLookup(pSys, "\\");
     if (pFW)
     {
         dictAppendWord(dp, "//", pFW->code, FW_DEFAULT);
@@ -186,6 +195,5 @@ void ficlCompilePrefix(FICL_SYSTEM *pSys)
 #endif
     dp->pCompile = pPrevCompile;
 
-    ficlAddPrecompiledParseStep(pSys, "prefix?", ficlParsePrefix);
     return;
 }
diff --git a/sys/boot/ficl/search.c b/sys/boot/ficl/search.c
index 36844ea..d445cb3 100644
--- a/sys/boot/ficl/search.c
+++ b/sys/boot/ficl/search.c
@@ -4,7 +4,7 @@
 ** ANS Forth SEARCH and SEARCH-EXT word-set written in C
 ** Author: John Sadler (john_sadler@alum.mit.edu)
 ** Created: 6 June 2000
-** $Id: search.c,v 1.4 2001-04-26 21:41:31-07 jsadler Exp jsadler $
+** $Id: search.c,v 1.9 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -12,6 +12,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -34,13 +39,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: search.c,v 1.4 2001-04-26 21:41:31-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
@@ -59,7 +57,7 @@
 **************************************************************************/
 static void definitions(FICL_VM *pVM)
 {
-    FICL_DICT *pDict = ficlGetDict();
+    FICL_DICT *pDict = vmGetDict(pVM);
 
     assert(pDict);
     if (pDict->nLists < 1)
@@ -81,7 +79,7 @@ static void definitions(FICL_VM *pVM)
 **************************************************************************/
 static void forthWordlist(FICL_VM *pVM)
 {
-    FICL_HASH *pHash = ficlGetDict()->pForthWords;
+    FICL_HASH *pHash = vmGetDict(pVM)->pForthWords;
     stackPushPtr(pVM->pStack, pHash);
     return;
 }
@@ -95,7 +93,7 @@ static void forthWordlist(FICL_VM *pVM)
 static void getCurrent(FICL_VM *pVM)
 {
     ficlLockDictionary(TRUE);
-    stackPushPtr(pVM->pStack, ficlGetDict()->pCompile);
+    stackPushPtr(pVM->pStack, vmGetDict(pVM)->pCompile);
     ficlLockDictionary(FALSE);
     return;
 }
@@ -111,7 +109,7 @@ static void getCurrent(FICL_VM *pVM)
 **************************************************************************/
 static void getOrder(FICL_VM *pVM)
 {
-    FICL_DICT *pDict = ficlGetDict();
+    FICL_DICT *pDict = vmGetDict(pVM);
     int nLists = pDict->nLists;
     int i;
 
@@ -172,7 +170,7 @@ static void searchWordlist(FICL_VM *pVM)
 static void setCurrent(FICL_VM *pVM)
 {
     FICL_HASH *pHash = stackPopPtr(pVM->pStack);
-    FICL_DICT *pDict = ficlGetDict();
+    FICL_DICT *pDict = vmGetDict(pVM);
     ficlLockDictionary(TRUE);
     pDict->pCompile = pHash;
     ficlLockDictionary(FALSE);
@@ -195,7 +193,7 @@ static void setOrder(FICL_VM *pVM)
 {
     int i;
     int nLists = stackPopINT(pVM->pStack);
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
     if (nLists > FICL_DEFAULT_VOCS)
     {
@@ -239,7 +237,7 @@ static void setOrder(FICL_VM *pVM)
 **************************************************************************/
 static void ficlWordlist(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     FICL_HASH *pHash;
     FICL_UNS nBuckets;
     
@@ -260,7 +258,7 @@ static void ficlWordlist(FICL_VM *pVM)
 **************************************************************************/
 static void searchPop(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     int nLists;
 
     ficlLockDictionary(TRUE);
@@ -282,7 +280,7 @@ static void searchPop(FICL_VM *pVM)
 **************************************************************************/
 static void searchPush(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
     ficlLockDictionary(TRUE);
     if (dp->nLists > FICL_DEFAULT_VOCS)
@@ -304,7 +302,7 @@ static void widGetName(FICL_VM *pVM)
 {
     FICL_HASH *pHash = vmPop(pVM).p;
     char *cp = pHash->name;
-    int len = 0;
+    FICL_INT len = 0;
     
     if (cp)
         len = strlen(cp);
@@ -382,9 +380,9 @@ void ficlCompileSearch(FICL_SYSTEM *pSys)
     /*
     ** Set SEARCH environment query values
     */
-    ficlSetEnv("search-order",      FICL_TRUE);
-    ficlSetEnv("search-order-ext",  FICL_TRUE);
-    ficlSetEnv("wordlists",         FICL_DEFAULT_VOCS);
+    ficlSetEnv(pSys, "search-order",      FICL_TRUE);
+    ficlSetEnv(pSys, "search-order-ext",  FICL_TRUE);
+    ficlSetEnv(pSys, "wordlists",         FICL_DEFAULT_VOCS);
 
     dictAppendWord(dp, "wid-get-name", widGetName,  FW_DEFAULT);
     dictAppendWord(dp, "wid-set-name", widSetName,  FW_DEFAULT);
diff --git a/sys/boot/ficl/softwords/ficlclass.fr b/sys/boot/ficl/softwords/ficlclass.fr
new file mode 100644
index 0000000..6d75efb
--- /dev/null
+++ b/sys/boot/ficl/softwords/ficlclass.fr
@@ -0,0 +1,86 @@
+\ #if (FICL_WANT_OOP)
+\ ** ficl/softwords/ficlclass.fr
+\ Classes to model ficl data structures in objects
+\ This is a demo!
+\ John Sadler 14 Sep 1998
+\
+\ ** C - W O R D
+\ Models a FICL_WORD
+\
+\ $FreeBSD$
+
+object subclass c-word
+    c-word     ref: .link
+    c-2byte    obj: .hashcode
+    c-byte     obj: .flags
+    c-byte     obj: .nName
+    c-bytePtr  obj: .pName
+    c-cellPtr  obj: .pCode
+    c-4byte    obj: .param0
+
+    \ Push word's name...
+    : get-name   ( inst class -- c-addr u )
+        2dup
+        my=[ .pName get-ptr ] -rot
+        my=[ .nName get ]
+    ;
+
+    : next   ( inst class -- link-inst class )
+        my=> .link ;
+        
+    : ?
+        ." c-word: " 
+        2dup --> get-name type cr
+    ;
+
+end-class
+
+\ ** C - W O R D L I S T
+\ Models a FICL_HASH
+\ Example of use:
+\ get-current c-wordlist --> ref current
+\ current --> ?
+\ current --> .hash --> ?
+\ current --> .hash --> next --> ?
+
+object subclass c-wordlist
+    c-wordlist ref: .parent
+    c-ptr      obj: .name
+    c-cell     obj: .size
+    c-word     ref: .hash   ( first entry in hash table )
+
+    : ?
+        --> get-name ." ficl wordlist "  type cr ;
+    : push  drop  >search ;
+    : pop   2drop previous ;
+    : set-current   drop set-current ;
+    : get-name   drop wid-get-name ;
+    : words   { 2:this -- }
+        this my=[ .size get ] 0 do 
+            i this my=[ .hash index ]  ( 2list-head )
+            begin
+                2dup --> get-name type space
+                --> next over
+            0= until 2drop cr
+        loop
+    ;
+end-class
+
+\ : named-wid  wordlist postpone c-wordlist  metaclass => ref ;
+
+
+\ ** C - F I C L S T A C K
+object subclass c-ficlstack
+    c-4byte    obj: .nCells
+    c-cellPtr  obj: .link
+    c-cellPtr  obj: .sp
+    c-4byte    obj: .stackBase
+
+    : init   2drop ;
+    : ?      2drop
+        ." ficl stack " cr ;
+    : top
+        --> .sp --> .addr --> prev --> get ;
+end-class
+
+\ #endif
diff --git a/sys/boot/ficl/softwords/fileaccess.fr b/sys/boot/ficl/softwords/fileaccess.fr
new file mode 100644
index 0000000..10ec5bd
--- /dev/null
+++ b/sys/boot/ficl/softwords/fileaccess.fr
@@ -0,0 +1,26 @@
+\ #if FICL_WANT_FILE
+\ ** 
+\ ** File Access words for ficl
+\ ** submitted by Larry Hastings, larry@hastings.org
+\ **
+\
+\ $FreeBSD$
+
+: r/o 1 ;
+: r/w 3 ; 
+: w/o 2 ; 
+: bin 8 or ; 
+
+: included
+    r/o bin open-file 0= if
+        locals| f | end-locals
+        f include-file
+        f close-file drop
+    else
+        drop
+    endif
+    ;
+
+: include parse-word included ; immediate
+
+\ #endif
diff --git a/sys/boot/ficl/softwords/forml.fr b/sys/boot/ficl/softwords/forml.fr
new file mode 100644
index 0000000..1144ef5
--- /dev/null
+++ b/sys/boot/ficl/softwords/forml.fr
@@ -0,0 +1,75 @@
+\ examples from FORML conference paper Nov 98
+\ sadler
+\
+\ $FreeBSD$
+
+.( loading FORML examples ) cr
+object --> sub c-example
+             cell: .cell0
+    c-4byte   obj: .nCells
+  4 c-4byte array: .quad
+       c-byte obj: .length
+         79 chars: .name
+
+    : init   ( inst class -- )
+        2dup  object => init
+        s" aardvark"  2swap  --> set-name
+    ;
+
+    : get-name  ( inst class -- c-addr u )
+        2dup 
+        --> .name  -rot      ( c-addr inst class )
+        --> .length --> get
+    ;
+
+    : set-name  { c-addr u 2:this -- }
+        u       this --> .length --> set
+        c-addr  this --> .name  u move
+    ;
+
+    : ?  ( inst class ) c-example => get-name type cr ;
+end-class
+
+
+: test ." this is a test" cr ;
+' test
+c-word --> ref testref
+
+\ add a method to c-word...
+c-word --> get-wid ficl-set-current
+\ list dictionary thread
+: list  ( inst class )
+    begin
+        2dup --> get-name type cr 
+        --> next over 
+    0= until
+    2drop
+;
+set-current 
+
+object subclass c-led
+    c-byte obj: .state
+
+    : on   { led# 2:this -- }
+        this --> .state --> get
+        1 led# lshift or dup !oreg
+        this --> .state --> set
+    ;
+
+    : off   { led# 2:this -- }
+        this --> .state --> get
+        1 led# lshift invert and dup !oreg
+        this --> .state --> set
+    ;
+
+end-class
+
+
+object subclass c-switch
+
+    : ?on   { bit# 2:this -- flag }
+        
+        1 bit# lshift
+    ;
+end-class
+
diff --git a/sys/boot/ficl/softwords/ifbrack.fr b/sys/boot/ficl/softwords/ifbrack.fr
index 2359e94..a8c6062 100644
--- a/sys/boot/ficl/softwords/ifbrack.fr
+++ b/sys/boot/ficl/softwords/ifbrack.fr
@@ -1,29 +1,22 @@
 \ ** ficl/softwords/ifbrack.fr
 \ ** ANS conditional compile directives [if] [else] [then]
 \ ** Requires ficl 2.0 or greater...
-
+\
 \ $FreeBSD$
 
 hide
 
 : ?[if]   ( c-addr u -- c-addr u flag )
-    2dup 2dup
-    s" [if]" compare 0= >r
-    s" [IF]" compare 0= r> 
-    or
+    2dup s" [if]" compare-insensitive 0=
 ;
 
 : ?[else]   ( c-addr u -- c-addr u flag )
-    2dup 2dup
-    s" [else]" compare 0= >r
-    s" [ELSE]" compare 0= r> 
-    or
+    2dup s" [else]" compare-insensitive 0=
 ;
 
 : ?[then]   ( c-addr u -- c-addr u flag )
-    2dup 2dup
-    s" [then]" compare 0= >r
-    s" [THEN]" compare 0= r> 
+    2dup s" [then]" compare-insensitive 0= >r
+    2dup s" [endif]" compare-insensitive 0= r> 
     or
 ;
 
@@ -52,5 +45,6 @@ set-current
 0= if postpone [else] then ;  immediate
 
 : [then]  ( -- )  ;  immediate
+: [endif]  ( -- )  ;  immediate
 
 previous
diff --git a/sys/boot/ficl/softwords/marker.fr b/sys/boot/ficl/softwords/marker.fr
index c80c2cf..ee3c9bd 100644
--- a/sys/boot/ficl/softwords/marker.fr
+++ b/sys/boot/ficl/softwords/marker.fr
@@ -2,6 +2,8 @@
 \ ** Ficl implementation of CORE EXT MARKER
 \ John Sadler, 4 Oct 98
 \ Requires ficl 2.02 FORGET-WID !!
+\
+\ $FreeBSD$
 
 : marker   ( "name" -- )
     create  
diff --git a/sys/boot/ficl/softwords/oo.fr b/sys/boot/ficl/softwords/oo.fr
index 87ab576..9e6a04e 100644
--- a/sys/boot/ficl/softwords/oo.fr
+++ b/sys/boot/ficl/softwords/oo.fr
@@ -30,8 +30,7 @@ also oop definitions
 \ 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
+\ executed. 
 
 \ A ficl class consists of a parent class pointer, a wordlist
 \ ID for the methods of the class, and a size for the payload
@@ -43,9 +42,40 @@ also oop definitions
 \ cell 2: size of instance's payload
 
 \ Methods expect an object couple ( instance class ) 
-\ on the stack.
+\ on the stack. This is by convention - ficl has no way to 
+\ police your code to make sure this is always done, but it 
+\ happens naturally if you use the facilities presented here.
+\
 \ Overridden methods must maintain the same stack signature as
-\ their predecessors. Ficl has no way of enforcing this, though.
+\ their predecessors. Ficl has no way of enforcing this, either.
+\
+\ Revised Apr 2001 - Added Guy Carver's vtable extensions. Class now
+\ has an extra field for the vtable method count. Hasvtable declares
+\ refs to vtable classes
+\
+\ Revised Nov 2001 - metaclass debug method now finds only metaclass methods
+\
+\ Planned: Ficl vtable support
+\ Each class has a vtable size parameter
+\ END-CLASS allocates and clears the vtable - then it walks class's method 
+\ list and inserts all new methods into table. For each method, if the table
+\ slot is already nonzero, do nothing (overridden method). Otherwise fill
+\ vtable slot. Now do same check for parent class vtable, filling only
+\ empty slots in the new vtable.
+\ Methods are now structured as follows:
+\ - header
+\ - vtable index
+\ - xt
+\ :noname definition for code
+\
+\ : is redefined to check for override, fill in vtable index, increment method
+\ count if not an override, create header and fill in index. Allot code pointer
+\ and run :noname
+\ ; is overridden to fill in xt returned by :noname
+\ --> compiles code to fetch vtable address, offset by index, and execute
+\ => looks up xt in the vtable and compiles it directly
+
+
 
 user current-class
 0 current-class !
@@ -54,30 +84,38 @@ user 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.
 \
 
 hide
 
+\ p a r s e - m e t h o d
+\ compiles a 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
+    postpone sliteral
 ; compile-only
 
+\ l o o k u p - m e t h o d
+\ takes a counted string method name from the stack (as compiled
+\ by parse-method) and attempts to look this method up in the method list of 
+\ the class that's on the stack. If successful, it leaves the class on the stack
+\ and pushes the xt of the method. If not, it aborts with an error message.
+
 : lookup-method  { class 2:name -- class xt }
-	name class cell+ @  ( c-addr u wid )
-	search-wordlist     ( 0 | xt 1 | xt -1 )
-	0= if
-		name type ."  not found in " 
+    name class cell+ @  ( c-addr u wid )
+    search-wordlist     ( 0 | xt 1 | xt -1 )
+    0= if
+        name type ."  not found in " 
         class body> >name type
         cr abort 
-	endif 
+    endif 
     class swap
 ;
 
 : find-method-xt   \ name ( class -- class xt )
-	parse-word lookup-method
+    parse-word lookup-method
 ;
 
 set-current  ( stop hiding definitions )
@@ -96,23 +134,28 @@ set-current  ( stop hiding definitions )
 \
 : -->   ( instance class -- ??? )
     state @ 0= if
-		find-method-xt execute 
+        find-method-xt execute 
     else  
-		parse-method  postpone exec-method
+        parse-method  postpone exec-method
     endif
 ; immediate
 
 \ Method lookup with CATCH in case of exceptions
 : c->   ( instance class -- ?? exc-flag )
     state @ 0= if
-		find-method-xt catch  
+        find-method-xt catch  
     else  
-		parse-method  postpone catch-method
+        parse-method  postpone catch-method
     endif
 ; immediate
 
 \ METHOD  makes global words that do method invocations by late binding
 \ in case you prefer this style (no --> in your code)
+\ Example: everything has next and prev for array access, so...
+\ method next
+\ method prev
+\ my-instance next ( does whatever next does to my-instance by late binding )
+
 : method   create does> body> >name lookup-method execute ;
 
 
@@ -130,20 +173,30 @@ set-current  ( stop hiding definitions )
 instance-vars dup >search ficl-set-current
 
 : =>   \ c:( class meta -- ) run: ( -- ??? ) invokes compiled method
-	drop find-method-xt compile, drop
+    drop find-method-xt compile, drop
 ; immediate compile-only
 
 : my=>   \ c:( -- ) run: ( -- ??? ) late bind compiled method of current-class
     current-class @ dup postpone =>
 ; immediate compile-only
 
+\ Problem: my=[ assumes that each method except the last is am obj: member
+\ which contains its class as the first field of its parameter area. The code
+\ detects non-obect members and assumes the class does not change in this case.
+\ This handles methods like index, prev, and next correctly, but does not deal
+\ correctly with CLASS.
 : my=[   \ same as my=> , but binds a chain of methods
     current-class @  
     begin 
-        parse-word 2dup 
-        s" ]" compare while  ( class c-addr u )
-        lookup-method  nip  dup             ( xt xt )
-        compile,  >body cell+ @             ( class' )
+        parse-word 2dup             ( class c-addr u c-addr u )
+        s" ]" compare while         ( class c-addr u )
+        lookup-method               ( class xt )
+        dup compile,                ( class xt )
+        dup ?object if        \ If object member, get new class. Otherwise assume same class
+           nip >body cell+ @        ( new-class )
+        else 
+           drop                     ( class )
+        endif
     repeat 2drop drop 
 ; immediate compile-only
 
@@ -164,7 +217,7 @@ instance-vars dup >search ficl-set-current
 \
 : do-instance-var
     does>   ( instance class addr[offset] -- addr[field] )
-		nip @ +
+        nip @ +
 ;
 
 : addr-units:  ( offset size "name" -- offset' )
@@ -172,14 +225,14 @@ instance-vars dup >search ficl-set-current
     do-instance-var
 ;
 
-: chars:	\ ( offset nCells "name" -- offset' ) Create n char member.
+: chars:    \ ( offset nCells "name" -- offset' ) Create n char member.
    chars addr-units: ;
 
-: char:		\ ( offset nCells "name" -- offset' ) Create 1 char member.
+: char:     \ ( offset nCells "name" -- offset' ) Create 1 char member.
    1 chars: ;
 
 : cells:  ( offset nCells "name" -- offset' )
-	cells >r aligned r> addr-units:
+    cells >r aligned r> addr-units:
 ;
 
 : cell:   ( offset nCells "name" -- offset' )
@@ -190,17 +243,17 @@ instance-vars dup >search ficl-set-current
 \ 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 )
+    objectify
+    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 |
+: obj:   { offset class meta -- offset' }  \ "name" 
     create  offset , class , 
-	class meta --> get-size  offset +
-	do-aggregate
+    class meta --> get-size  offset +
+    do-aggregate
 ;
 
 \ Aggregate an array of objects into a class
@@ -210,10 +263,10 @@ instance-vars dup >search ficl-set-current
 \ 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
+    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
@@ -223,13 +276,35 @@ instance-vars dup >search ficl-set-current
 \ 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
+    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
+;
+
+\ #if FICL_WANT_VCALL
+\ vcall extensions contributed by Guy Carver
+: vcall:  ( paramcnt "name" -- )   
+    current-class @ 8 + dup @ dup 1+ rot !  \ Kludge fix to get to .vtCount before it's defined.
+    create , ,                              \ ( paramcnt index -- )
+    does>                                   \ ( inst class pfa -- ptr-inst ptr-class )
+   nip 2@ vcall                             \ ( params offset inst class offset -- )
+;
+
+: vcallr: 0x80000000 or vcall: ;            \ Call with return address desired.
+
+\ #if FICL_WANT_FLOAT
+: vcallf:                                   \ ( paramcnt -<name>- f: r )
+    0x80000000 or 
+    current-class @ 8 + dup @ dup 1+ rot !  \ Kludge fix to get to .vtCount before it's defined.
+    create , ,                              \ ( paramcnt index -- )
+    does>                                   \ ( inst class pfa -- ptr-inst ptr-class )
+    nip 2@ vcall f>                         \ ( params offset inst class offset -- f: r )
 ;
+\ #endif /* FLOAT */
+\ #endif /* VCALL */
 
 \ END-CLASS terminates construction of a class by storing
 \  the size of its instance variables in the class's size field
@@ -237,7 +312,7 @@ instance-vars dup >search ficl-set-current
 \
 : end-class  ( old-wid addr[size] size -- )
     swap ! set-current 
-	search> drop		\ pop struct builder wordlist
+    search> drop        \ pop struct builder wordlist
 ;
 
 \ See resume-class (a metaclass method) below for usage
@@ -256,7 +331,7 @@ set-current previous
 \ the wordlist of every class by the SUB method.
 \ PRECONDITION: current-class contains the class address
 \ why use a state variable instead of the stack?
-\ >> Stack state is not well-defined during compilation	(there are
+\ >> Stack state is not well-defined during compilation (there are
 \ >> control structure match codes on the stack, of undefined size
 \ >> easiest way around this is use of this thread-local variable
 \
@@ -274,14 +349,18 @@ set-current previous
 \ See above...
 \
 :noname
-	wordlist
-	create  
+    wordlist
+    create  
     immediate
-	0       ,	\ NULL parent class
-	dup     ,	\ wid
-	3 cells ,	\ instance size 
-	ficl-set-current
-	does> dup
+    0       ,   \ NULL parent class
+    dup     ,   \ wid
+\ #if FICL_WANT_VCALL
+    4 cells ,   \ instance size 
+\ #else
+    3 cells ,   \ instance size 
+\ #endif
+    ficl-set-current
+    does> dup
 ;  execute metaclass 
 \ now brand OBJECT's wordlist (so that ORDER can display it by name)
 metaclass drop cell+ @ brand-wordlist
@@ -300,19 +379,31 @@ create .super  ( class metaclass -- parent-class )
 create .wid    ( class metaclass -- wid ) \ return wid of class
     1 cells , do-instance-var 
 
+\ #if FICL_WANT_VCALL
+create .vtCount   \ Number of VTABLE methods, if any
+    2 cells , do-instance-var 
+
+create  .size  ( class metaclass -- size ) \ return class's payload size 
+    3 cells , do-instance-var 
+\ #else
 create  .size  ( class metaclass -- size ) \ return class's payload size 
     2 cells , do-instance-var 
+\ #endif
 
 : get-size    metaclass => .size  @ ;
 : get-wid     metaclass => .wid   @ ;
 : get-super   metaclass => .super @ ;
+\ #if FICL_WANT_VCALL
+: get-vtCount metaclass => .vtCount @ ;
+: get-vtAdd   metaclass => .vtCount ;
+\ #endif
 
 \ 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
+    create
     here parent --> .do-instance \ ( inst class )
     parent meta metaclass => get-size 
     allot                        \ allocate payload space
@@ -321,10 +412,10 @@ create  .size  ( class metaclass -- size ) \ return class's payload size
 \ create an uninitialized array
 : array   ( n class metaclass "name" -- n instance class ) 
     locals| meta parent nobj |
-	create  nobj
+    create  nobj
     here parent --> .do-instance \ ( nobj inst class )
     parent meta metaclass => get-size
-	nobj *  allot			\ allocate payload space
+    nobj *  allot           \ allocate payload space
 ;
 
 \ create an initialized instance
@@ -335,8 +426,8 @@ create  .size  ( class metaclass -- size ) \ return class's payload size
 
 \ create an initialized array of instances
 : new-array   ( n class metaclass "name" -- ) 
-	metaclass => array 
-	--> array-init
+    metaclass => array 
+    --> array-init
 ;
 
 \ Create an anonymous initialized instance from the heap
@@ -406,19 +497,22 @@ create  .size  ( class metaclass -- size ) \ return class's payload size
 \ Postcondition: leaves the address of the new class in current-class
 : sub   ( class metaclass "name" -- old-wid addr[size] size )
     wordlist
-	locals| wid meta parent |
-	parent meta metaclass => get-wid
-	wid wid-set-super       \ set superclass
-	create  immediate       \ get the  subclass name
+    locals| wid meta parent |
+    parent meta metaclass => get-wid
+    wid wid-set-super       \ set superclass
+    create  immediate       \ get the  subclass name
     wid brand-wordlist      \ label the subclass wordlist
-	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
+    here current-class !    \ prep for do-do-instance
+    parent ,                \ save parent class
+    wid    ,                \ save wid
+\ #if FICL_WANT_VCALL
+    parent meta --> get-vtCount , 
+\ #endif
+    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
@@ -430,34 +524,39 @@ create  .size  ( class metaclass -- size ) \ return class's payload size
 
 \ ID returns the string name cell-pair of its class
 : id   ( class metaclass -- c-addr u )
-	drop body> >name  ;
+    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
+    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
+    locals| meta class |
+    begin
+        class body> >name type space
+        class meta metaclass => get-super
+        dup to class
+    0= until  cr
 ;
 
-\ decompile a method
+\ decompile an instance method
 : see  ( class meta -- )   
     metaclass => get-wid >search see previous ;
 
-previous set-current	
+\ debug a method of metaclass
+\ Eg: my-class --> debug my-method
+: debug  ( class meta -- )
+	find-method-xt debug-xt ;
+
+previous set-current    
 \ E N D   M E T A C L A S S
 
 \ ** META is a nickname for the address of METACLASS...
@@ -469,18 +568,24 @@ constant meta
 \ This method is late bound for safety...
 : subclass   --> sub ;
 
+\ #if FICL_WANT_VCALL
+\ VTABLE Support extensions (Guy Carver)
+\ object --> sub mine hasvtable
+: hasvtable 4 + ; immediate
+\ #endif
+
 
 \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 \ ** 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
+    wordlist
+    create  immediate
+    0       ,   \ NULL parent class
+    dup     ,   \ wid
+    0       ,   \ instance size 
+    ficl-set-current
+    does> meta
 ;  execute object
 \ now brand OBJECT's wordlist (so that ORDER can display it by name)
 object drop cell+ @ brand-wordlist
@@ -493,7 +598,7 @@ instance-vars >search
 \ Convert instance cell-pair to class cell-pair
 \ Useful for binding class methods from an instance
 : class  ( instance class -- class metaclass )
-	nip meta ;
+    nip meta ;
 
 \ default INIT method zero fills an instance
 : init   ( instance class -- )
@@ -504,26 +609,26 @@ instance-vars >search
 \ 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
+    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
 ;
 
 \ free storage allocated to a heap instance by alloc or alloc-array
 \ NOTE: not protected against errors like FREEing something that's
 \ really in the dictionary.
 : free   \ ( instance class -- )
-	drop free 
-	abort" free failed "
+    drop free 
+    abort" free failed "
 ;
 
 \ Instance aliases for common class methods
@@ -532,15 +637,15 @@ instance-vars >search
     meta  metaclass => get-super ;
 
 : pedigree  ( instance class -- )
-	object => class 
+    object => class 
     metaclass => pedigree ;
 
 : size      ( instance class -- sizeof-instance )
-	object => class 
+    object => class 
     metaclass => get-size ;
 
 : methods   ( instance class -- )
-	object => class 
+    object => class 
     metaclass => methods ;
 
 \ Array indexing methods...
@@ -549,27 +654,27 @@ instance-vars >search
 \ obj --> next
 \
 : index   ( n instance class -- instance[n] class )
-	locals| class inst |
-	inst class 
+    locals| class inst |
+    inst class 
     object => class
-	metaclass => get-size  *   ( n*size )
-	inst +  class ;
+    metaclass => get-size  *   ( n*size )
+    inst +  class ;
 
 : next   ( instance[n] class -- instance[n+1] class )
-	locals| class inst |
-	inst class 
+    locals| class inst |
+    inst class 
     object => class
-	metaclass => get-size 
-	inst +
-	class ;
+    metaclass => get-size 
+    inst +
+    class ;
 
 : prev   ( instance[n] class -- instance[n-1] class )
-	locals| class inst |
-	inst class 
+    locals| class inst |
+    inst class 
     object => class
-	metaclass => get-size
-	inst swap -
-	class ;
+    metaclass => get-size
+    inst swap -
+    class ;
 
 : debug   ( 2this --  ?? )
     find-method-xt debug-xt ;
@@ -577,6 +682,12 @@ instance-vars >search
 previous set-current
 \ E N D   O B J E C T
 
-
+\ reset to default search order
 only definitions
+
+\ redefine oop in default search order to put OOP words in the search order and make them
+\ the compiling wordlist...
+
+: oo   only also oop definitions ;
+
 \ #endif
diff --git a/sys/boot/ficl/softwords/prefix.fr b/sys/boot/ficl/softwords/prefix.fr
index d7b79a9..53a1d54 100644
--- a/sys/boot/ficl/softwords/prefix.fr
+++ b/sys/boot/ficl/softwords/prefix.fr
@@ -4,7 +4,7 @@
 \ **
 \ (jws) To make a prefix, simply create a new definition in the <prefixes> 
 \ wordlist. start-prefixes and end-prefixes handle the bookkeeping
-
+\
 \ $FreeBSD$
 
 variable save-current
diff --git a/sys/boot/ficl/softwords/softcore.fr b/sys/boot/ficl/softwords/softcore.fr
index 17844a8..a70ebaa 100644
--- a/sys/boot/ficl/softwords/softcore.fr
+++ b/sys/boot/ficl/softwords/softcore.fr
@@ -2,12 +2,11 @@
 \ ** FICL soft extensions
 \ ** John Sadler (john_sadler@alum.mit.edu)
 \ ** September, 1998
-
+\
 \ $FreeBSD$
 
 \ ** Ficl USER variables
 \ ** See words.c for primitive def'n of USER
-
 \ #if FICL_WANT_USER
 variable nUser  0 nUser ! 
 : user   \ name ( -- )  
@@ -35,7 +34,6 @@ decimal 32 constant bl
     state @ if
         postpone if
         postpone ."
-\        postpone type
         postpone cr
         -2
         postpone literal
@@ -60,7 +58,11 @@ false invert constant true
 : <>   = 0= ; 
 : 0<>  0= 0= ; 
 : compile,  , ; 
+: convert   char+ 65535 >number drop ;  \ cribbed from DPANS A.6.2.0970
 : erase   ( addr u -- )    0 fill ; 
+variable span
+: expect  ( c-addr u1 -- ) accept span ! ;
+\ see marker.fr for MARKER implementation
 : nip     ( y x -- x )     swap drop ; 
 : tuck    ( y x -- x y x)  swap over ; 
 : within  ( test low high -- flag )   over - >r - r>  u<  ;
@@ -168,7 +170,35 @@ set-current   \ stop hiding words
    ." Compile: " get-current list-wid cr  
 ; 
 
-: debug  ' debug-xt ;
+: debug  ' debug-xt ; immediate
+: on-step   ." S: " .s cr ;
+
+
+\ Submitted by lch.
+: strdup ( c-addr length -- c-addr2 length2 ior )
+	0 locals| addr2 length c-addr | end-locals
+	length 1 + allocate
+	0= if
+		to addr2
+		c-addr addr2 length move
+		addr2 length 0
+	else
+		0  -1
+	endif
+	;
+
+: strcat ( 2:a 2:b -- 2:new-a )
+	0 locals|  b-length b-u b-addr a-u a-addr | end-locals
+	b-u  to b-length
+	b-addr a-addr a-u + b-length  move
+	a-addr a-u b-length +
+	;
+
+: strcpy ( 2:a 2:b -- 2:new-a )
+	locals| b-u b-addr a-u a-addr | end-locals
+	a-addr 0  b-addr b-u  strcat
+	;
+
 
 previous   \ lose hidden words from search order
 
diff --git a/sys/boot/ficl/stack.c b/sys/boot/ficl/stack.c
index ab0ab46..f98a3b6 100644
--- a/sys/boot/ficl/stack.c
+++ b/sys/boot/ficl/stack.c
@@ -3,7 +3,7 @@
 ** Forth Inspired Command Language
 ** Author: John Sadler (john_sadler@alum.mit.edu)
 ** Created: 16 Oct 1997
-** $Id: stack.c,v 1.5 2001-04-26 21:41:29-07 jsadler Exp jsadler $
+** $Id: stack.c,v 1.10 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -11,6 +11,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -33,13 +38,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: stack.c,v 1.5 2001-04-26 21:41:29-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
@@ -299,7 +297,7 @@ void stackPushINT(FICL_STACK *pStack, FICL_INT i)
 }
 
 #if (FICL_WANT_FLOAT)
-void stackPushFloat(FICL_STACK *pStack, float f)
+void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f)
 {
     *pStack->sp++ = LVALUEtoCELL(f);
 }
diff --git a/sys/boot/ficl/testmain.c b/sys/boot/ficl/testmain.c
index cd4da7e..7167f30 100644
--- a/sys/boot/ficl/testmain.c
+++ b/sys/boot/ficl/testmain.c
@@ -1,6 +1,40 @@
 /*
-** stub main for testing FICL under Win32
-** $Id: testmain.c,v 1.6 2000-06-17 07:43:50-07 jsadler Exp jsadler $
+** stub main for testing FICL under userland
+** $Id: testmain.c,v 1.13 2001/12/05 07:21:34 jsadler Exp $
+*/
+/*
+** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
+** All rights reserved.
+**
+** Get the latest Ficl release at http://ficl.sourceforge.net
+**
+** 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, please
+** contact me by email at the address above.
+**
+** L I C E N S E  and  D I S C L A I M E R
+** 
+** Redistribution and use in source and binary forms, with or without
+** modification, are permitted provided that the following conditions
+** are met:
+** 1. Redistributions of source code must retain the above copyright
+**    notice, this list of conditions and the following disclaimer.
+** 2. Redistributions in binary form must reproduce the above copyright
+**    notice, this list of conditions and the following disclaimer in the
+**    documentation and/or other materials provided with the distribution.
+**
+** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+** ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+** SUCH DAMAGE.
 */
 
 /* $FreeBSD$ */
@@ -24,7 +58,7 @@ static void ficlGetCWD(FICL_VM *pVM)
 {
     char *cp;
 
-   cp = getcwd(NULL, 80);
+    cp = getcwd(NULL, 80);
     vmTextOut(pVM, cp, 1);
     free(cp);
     return;
@@ -62,7 +96,7 @@ static void ficlChDir(FICL_VM *pVM)
 ** Gets a newline (or NULL) delimited string from the input
 ** and feeds it to system()
 ** Example:
-**    system del *.*
+**    system rm -rf /
 **    \ ouch!
 */
 static void ficlSystem(FICL_VM *pVM)
@@ -150,10 +184,10 @@ static void ficlLoad(FICL_VM *pVM)
         result = ficlExecC(pVM, cp, len);
         if (result != VM_QUIT && result != VM_USEREXIT && result != VM_OUTOFTEXT )
         {
-            pVM->sourceID = id;
-            fclose(fp);
-            vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);
-            break; 
+                pVM->sourceID = id;
+                fclose(fp);
+                vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);
+                break; 
         }
     }
     /*
@@ -166,6 +200,9 @@ static void ficlLoad(FICL_VM *pVM)
     pVM->sourceID = id;
     fclose(fp);
 
+    /* handle "bye" in loaded files. --lch */
+    if (result == VM_USEREXIT)
+        vmThrow(pVM, VM_USEREXIT);
     return;
 }
 
@@ -175,7 +212,7 @@ static void ficlLoad(FICL_VM *pVM)
 */
 static void spewHash(FICL_VM *pVM)
 {
-    FICL_HASH *pHash = ficlGetDict()->pForthWords;
+    FICL_HASH *pHash = vmGetDict(pVM)->pForthWords;
     FICL_WORD *pFW;
     FILE *pOut;
     unsigned i;
@@ -252,18 +289,18 @@ static void execxt(FICL_VM *pVM)
 }
 
 
-void buildTestInterface(void)
+void buildTestInterface(FICL_SYSTEM *pSys)
 {
-    ficlBuild("break",    ficlBreak,    FW_DEFAULT);
-    ficlBuild("clock",    ficlClock,    FW_DEFAULT);
-    ficlBuild("cd",       ficlChDir,    FW_DEFAULT);
-    ficlBuild("execxt",   execxt,       FW_DEFAULT);
-    ficlBuild("load",     ficlLoad,     FW_DEFAULT);
-    ficlBuild("pwd",      ficlGetCWD,   FW_DEFAULT);
-    ficlBuild("system",   ficlSystem,   FW_DEFAULT);
-    ficlBuild("spewhash", spewHash,     FW_DEFAULT);
-    ficlBuild("clocks/sec", 
-                          clocksPerSec, FW_DEFAULT);
+    ficlBuild(pSys, "break",    ficlBreak,    FW_DEFAULT);
+    ficlBuild(pSys, "clock",    ficlClock,    FW_DEFAULT);
+    ficlBuild(pSys, "cd",       ficlChDir,    FW_DEFAULT);
+    ficlBuild(pSys, "execxt",   execxt,       FW_DEFAULT);
+    ficlBuild(pSys, "load",     ficlLoad,     FW_DEFAULT);
+    ficlBuild(pSys, "pwd",      ficlGetCWD,   FW_DEFAULT);
+    ficlBuild(pSys, "system",   ficlSystem,   FW_DEFAULT);
+    ficlBuild(pSys, "spewhash", spewHash,     FW_DEFAULT);
+    ficlBuild(pSys, "clocks/sec", 
+                                clocksPerSec, FW_DEFAULT);
 
     return;
 }
@@ -273,12 +310,13 @@ int main(int argc, char **argv)
 {
     char in[256];
     FICL_VM *pVM;
+	FICL_SYSTEM *pSys;
 
-    ficlInitSystem(10000);
-    buildTestInterface();
-    pVM = ficlNewVM();
+    pSys = ficlInitSystem(10000);
+    buildTestInterface(pSys);
+    pVM = ficlNewVM(pSys);
 
-    ficlExec(pVM, ".ver .( " __DATE__ " ) cr quit");
+    ficlEvaluate(pVM, ".ver .( " __DATE__ " ) cr quit");
 
     /*
     ** load file from cmd line...
@@ -286,7 +324,7 @@ int main(int argc, char **argv)
     if (argc  > 1)
     {
         sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
-        ficlExec(pVM, in);
+        ficlEvaluate(pVM, in);
     }
 
     for (;;)
@@ -297,7 +335,7 @@ int main(int argc, char **argv)
         ret = ficlExec(pVM, in);
         if (ret == VM_USEREXIT)
         {
-            ficlTermSystem();
+            ficlTermSystem(pSys);
             break;
         }
     }
diff --git a/sys/boot/ficl/tools.c b/sys/boot/ficl/tools.c
index 0fc1a88..dc321f8 100644
--- a/sys/boot/ficl/tools.c
+++ b/sys/boot/ficl/tools.c
@@ -3,27 +3,19 @@
 ** Forth Inspired Command Language - programming tools
 ** Author: John Sadler (john_sadler@alum.mit.edu)
 ** Created: 20 June 2000
-** $Id: tools.c,v 1.4 2001-04-26 21:41:24-07 jsadler Exp jsadler $
+** $Id: tools.c,v 1.11 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
-** NOTES:
-** SEE needs information about the addresses of functions that
-** are the CFAs of colon definitions, constants, variables, DOES>
-** words, and so on. It gets this information from a table and supporting
-** functions in words.c.
-** colonParen doDoes createParen variableParen userParen constantParen
-**
-** Step and break debugger for Ficl
-** debug  ( xt -- )   Start debugging an xt
-** Set a breakpoint
-** Specify breakpoint default action
-*/
-/*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
 ** All rights reserved.
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -46,13 +38,20 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
+*/
+
+/*
+** NOTES:
+** SEE needs information about the addresses of functions that
+** are the CFAs of colon definitions, constants, variables, DOES>
+** words, and so on. It gets this information from a table and supporting
+** functions in words.c.
+** colonParen doDoes createParen variableParen userParen constantParen
 **
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: tools.c,v 1.4 2001-04-26 21:41:24-07 jsadler Exp jsadler $
+** Step and break debugger for Ficl
+** debug  ( xt -- )   Start debugging an xt
+** Set a breakpoint
+** Specify breakpoint default action
 */
 
 /* $FreeBSD$ */
@@ -74,51 +73,45 @@
 ** for the STEP command. The rest are user programmable. 
 */
 #define nBREAKPOINTS 32
-#endif
 
-/*
-** BREAKPOINT record.
-** origXT - if NULL, this breakpoint is unused. Otherwise it stores the xt 
-** that the breakpoint overwrote. This is restored to the dictionary when the
-** BP executes or gets cleared
-** address - the location of the breakpoint (address of the instruction that
-**           has been replaced with the breakpoint trap
-** origXT  - The original contents of the location with the breakpoint
-** Note: address is NULL when this breakpoint is empty
-*/
-typedef struct breakpoint
-{
-    void      *address;
-    FICL_WORD *origXT;
-} BREAKPOINT;
+#endif
 
-static BREAKPOINT bpStep = {NULL, NULL};
 
-/*
-** vmSetBreak - set a breakpoint at the current value of IP by
+/**************************************************************************
+                        v m S e t B r e a k
+** Set a breakpoint at the current value of IP by
 ** storing that address in a BREAKPOINT record
-*/
-static void vmSetBreak(FICL_VM *pVM, BREAKPOINT *pBP)
+**************************************************************************/
+static void vmSetBreak(FICL_VM *pVM, FICL_BREAKPOINT *pBP)
 {
-    FICL_WORD *pStep = ficlLookup("step-break");
+    FICL_WORD *pStep = ficlLookup(pVM->pSys, "step-break");
     assert(pStep);
+
     pBP->address = pVM->ip;
     pBP->origXT = *pVM->ip;
     *pVM->ip = pStep;
 }
 
 
-/*
-** isAFiclWord
+/**************************************************************************
+**                      d e b u g P r o m p t
+**************************************************************************/
+static void debugPrompt(FICL_VM *pVM)
+{
+        vmTextOut(pVM, "dbg> ", 0);
+}
+
+
+/**************************************************************************
+**                      i s A F i c l W o r d
 ** 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!
-*/
-int isAFiclWord(FICL_WORD *pFW)
+**************************************************************************/
+int isAFiclWord(FICL_DICT *pd, FICL_WORD *pFW)
 {
-    FICL_DICT *pd  = ficlGetDict();
 
     if (!dictIncludes(pd, pFW))
        return 0;
@@ -126,15 +119,56 @@ int isAFiclWord(FICL_WORD *pFW)
     if (!dictIncludes(pd, pFW->name))
         return 0;
 
-    return ((pFW->nName > 0) && (pFW->name[pFW->nName] == '\0'));
+	if ((pFW->link != NULL) && !dictIncludes(pd, pFW->link))
+		return 0;
+
+    if ((pFW->nName <= 0) || (pFW->name[pFW->nName] != '\0'))
+		return 0;
+
+	if (strlen(pFW->name) != pFW->nName)
+		return 0;
+
+	return 1;
 }
 
 
+#if 0
 static int isPrimitive(FICL_WORD *pFW)
 {
     WORDKIND wk = ficlWordClassify(pFW);
     return ((wk != COLON) && (wk != DOES));
 }
+#endif
+
+
+/**************************************************************************
+                        f i n d E n c l o s i n g W o r d
+** Given a pointer to something, check to make sure it's an address in the 
+** dictionary. If so, search backwards until we find something that looks
+** like a dictionary header. If successful, return the address of the 
+** FICL_WORD found. Otherwise return NULL.
+** nSEARCH_CELLS sets the maximum neighborhood this func will search before giving up
+**************************************************************************/
+#define nSEARCH_CELLS 100
+
+static FICL_WORD *findEnclosingWord(FICL_VM *pVM, CELL *cp)
+{
+    FICL_WORD *pFW;
+    FICL_DICT *pd = vmGetDict(pVM);
+    int i;
+
+    if (!dictIncludes(pd, (void *)cp))
+        return NULL;
+
+    for (i = nSEARCH_CELLS; i > 0; --i, --cp)
+    {
+        pFW = (FICL_WORD *)(cp + 1 - (sizeof (FICL_WORD) / sizeof (CELL)));
+        if (isAFiclWord(pd, pFW))
+            return pFW;
+    }
+
+    return NULL;
+}
 
 
 /**************************************************************************
@@ -144,8 +178,6 @@ static int isPrimitive(FICL_WORD *pFW)
 ** 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.
 **************************************************************************/
 /*
 ** seeColon (for proctologists only)
@@ -154,17 +186,24 @@ static int isPrimitive(FICL_WORD *pFW)
 */
 static void seeColon(FICL_VM *pVM, CELL *pc)
 {
-    static FICL_WORD *pSemiParen = NULL;
-
-    if (!pSemiParen)
-        pSemiParen = ficlLookup("(;)");
+	char *cp;
+    CELL *param0 = pc;
+    FICL_DICT *pd = vmGetDict(pVM);
+	FICL_WORD *pSemiParen = ficlLookup(pVM->pSys, "(;)");
     assert(pSemiParen);
 
     for (; pc->p != pSemiParen; pc++)
     {
         FICL_WORD *pFW = (FICL_WORD *)(pc->p);
 
-        if (isAFiclWord(pFW))
+        cp = pVM->pad;
+		if ((void *)pc == (void *)pVM->ip)
+			*cp++ = '>';
+		else
+			*cp++ = ' ';
+        cp += sprintf(cp, "%3d   ", pc-param0);
+        
+        if (isAFiclWord(pd, pFW))
         {
             WORDKIND kind = ficlWordClassify(pFW);
             CELL c;
@@ -173,65 +212,72 @@ static void seeColon(FICL_VM *pVM, CELL *pc)
             {
             case LITERAL:
                 c = *++pc;
-                if (isAFiclWord(c.p))
+                if (isAFiclWord(pd, c.p))
                 {
                     FICL_WORD *pLit = (FICL_WORD *)c.p;
-                    sprintf(pVM->pad, "    literal %.*s (%#lx)", 
+                    sprintf(cp, "%.*s ( %#lx literal )", 
                         pLit->nName, pLit->name, c.u);
                 }
                 else
-                    sprintf(pVM->pad, "    literal %ld (%#lx)", c.i, c.u);
+                    sprintf(cp, "literal %ld (%#lx)", c.i, c.u);
                 break;
             case 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);
+                    sprintf(cp, "s\" %.*s\"", sp->count, sp->text);
+                }
+                break;
+            case CSTRINGLIT:
+                {
+                    FICL_STRING *sp = (FICL_STRING *)(void *)++pc;
+                    pc = (CELL *)alignPtr(sp->text + sp->count + 1) - 1;
+                    sprintf(cp, "c\" %.*s\"", sp->count, sp->text);
                 }
                 break;
             case IF:
                 c = *++pc;
                 if (c.i > 0)
-                    sprintf(pVM->pad, "    if / while (branch rel %ld)", c.i);
+                    sprintf(cp, "if / while (branch %d)", pc+c.i-param0);
                 else
-                    sprintf(pVM->pad, "    until (branch rel %ld)", c.i);
-                break;
+                    sprintf(cp, "until (branch %d)",      pc+c.i-param0);
+                break;                                                           
             case BRANCH:
                 c = *++pc;
                 if (c.i > 0)
-                    sprintf(pVM->pad, "    else (branch rel %ld)", c.i);
+                    sprintf(cp, "else (branch %d)",       pc+c.i-param0);
                 else
-                    sprintf(pVM->pad, "    repeat (branch rel %ld)", c.i);
+                    sprintf(cp, "repeat (branch %d)",     pc+c.i-param0);
                 break;
 
             case QDO:
                 c = *++pc;
-                sprintf(pVM->pad, "    ?do (leave abs %#lx)", c.u);
+                sprintf(cp, "?do (leave %d)",  (CELL *)c.p-param0);
                 break;
             case DO:
                 c = *++pc;
-                sprintf(pVM->pad, "    do (leave abs %#lx)", c.u);
+                sprintf(cp, "do (leave %d)", (CELL *)c.p-param0);
                 break;
             case LOOP:
                 c = *++pc;
-                sprintf(pVM->pad, "    loop (branch rel %#ld)", c.i);
+                sprintf(cp, "loop (branch %d)", pc+c.i-param0);
                 break;
             case PLOOP:
                 c = *++pc;
-                sprintf(pVM->pad, "    +loop (branch rel %#ld)", c.i);
+                sprintf(cp, "+loop (branch %d)", pc+c.i-param0);
                 break;
             default:
-                sprintf(pVM->pad, "    %.*s", pFW->nName, pFW->name);
+                sprintf(cp, "%.*s", pFW->nName, pFW->name);
                 break;
             }
  
-            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);
+            sprintf(cp, "%ld ( %#lx )", pc->i, pc->u);
         }
+
+		vmTextOut(pVM, pVM->pad, 1);
     }
 
     vmTextOut(pVM, ";", 1);
@@ -275,17 +321,20 @@ static void seeXT(FICL_VM *pVM)
         vmTextOut(pVM, pVM->pad, 1);
         break;
 
+#if FICL_WANT_USER
     case USER:
         sprintf(pVM->pad, "user variable %ld (%#lx)", pFW->param->i, pFW->param->u);
         vmTextOut(pVM, pVM->pad, 1);
         break;
+#endif
 
     case CONSTANT:
         sprintf(pVM->pad, "constant = %ld (%#lx)", pFW->param->i, pFW->param->u);
         vmTextOut(pVM, pVM->pad, 1);
 
     default:
-        vmTextOut(pVM, "primitive", 1);
+        sprintf(pVM->pad, "%.*s is a primitive", pFW->nName, pFW->name);
+        vmTextOut(pVM, pVM->pad, 1);
         break;
     }
 
@@ -323,9 +372,6 @@ void ficlDebugXT(FICL_VM *pVM)
 {
     FICL_WORD *xt    = stackPopPtr(pVM->pStack);
     WORDKIND   wk    = ficlWordClassify(xt);
-    FICL_WORD *pStep = ficlLookup("step-break");
-
-    assert(pStep);
 
     stackPushPtr(pVM->pStack, xt);
     seeXT(pVM);
@@ -338,9 +384,7 @@ void ficlDebugXT(FICL_VM *pVM)
         ** Run the colon code and set a breakpoint at the next instruction
         */
         vmExecute(pVM, xt);
-        bpStep.address = pVM->ip;
-        bpStep.origXT = *pVM->ip;
-        *pVM->ip = pStep;
+        vmSetBreak(pVM, &(pVM->pSys->bpStep));
         break;
 
     default:
@@ -370,7 +414,7 @@ void stepIn(FICL_VM *pVM)
     /*
     ** Now set a breakpoint at the next instruction
     */
-    vmSetBreak(pVM, &bpStep);
+    vmSetBreak(pVM, &(pVM->pSys->bpStep));
     
     return;
 }
@@ -387,7 +431,7 @@ void stepOver(FICL_VM *pVM)
 {
     FICL_WORD *pFW;
     WORDKIND kind;
-    FICL_WORD *pStep = ficlLookup("step-break");
+    FICL_WORD *pStep = ficlLookup(pVM->pSys, "step-break");
     assert(pStep);
 
     pFW = *pVM->ip;
@@ -401,8 +445,8 @@ void stepOver(FICL_VM *pVM)
         ** assume that the next cell holds an instruction 
         ** set a breakpoint there and return to the inner interp
         */
-        bpStep.address = pVM->ip + 1;
-        bpStep.origXT =  pVM->ip[1];
+        pVM->pSys->bpStep.address = pVM->ip + 1;
+        pVM->pSys->bpStep.origXT =  pVM->ip[1];
         pVM->ip[1] = pStep;
         break;
 
@@ -439,37 +483,37 @@ void stepBreak(FICL_VM *pVM)
 
     if (!pVM->fRestart)
     {
-
-        assert(bpStep.address != NULL);
+        assert(pVM->pSys->bpStep.address);
+        assert(pVM->pSys->bpStep.origXT);
         /*
         ** Clear the breakpoint that caused me to run
         ** Restore the original instruction at the breakpoint, 
         ** and restore the IP
         */
-        assert(bpStep.address);
-        assert(bpStep.origXT);
-
-        pVM->ip = (IPTYPE)bpStep.address;
-        *pVM->ip = bpStep.origXT;
+        pVM->ip = (IPTYPE)(pVM->pSys->bpStep.address);
+        *pVM->ip = pVM->pSys->bpStep.origXT;
 
         /*
         ** If there's an onStep, do it
         */
-        pOnStep = ficlLookup("on-step");
+        pOnStep = ficlLookup(pVM->pSys, "on-step");
         if (pOnStep)
             ficlExecXT(pVM, pOnStep);
 
         /*
         ** Print the name of the next instruction
         */
-        pFW = bpStep.origXT;
+        pFW = pVM->pSys->bpStep.origXT;
         sprintf(pVM->pad, "next: %.*s", pFW->nName, pFW->name);
+#if 0
         if (isPrimitive(pFW))
         {
-            strcat(pVM->pad, " primitive");
+            strcat(pVM->pad, " ( primitive )");
         }
+#endif
 
         vmTextOut(pVM, pVM->pad, 1);
+        debugPrompt(pVM);
     }
     else
     {
@@ -486,21 +530,60 @@ void stepBreak(FICL_VM *pVM)
     {
         return;
     }
+    else if (!strincmp(si.cp, "l", si.count))
+    {
+        FICL_WORD *xt;
+        xt = findEnclosingWord(pVM, (CELL *)(pVM->ip));
+        if (xt)
+        {
+            stackPushPtr(pVM->pStack, xt);
+            seeXT(pVM);
+        }
+        else
+        {
+            vmTextOut(pVM, "sorry - can't do that", 1);
+        }
+        vmThrow(pVM, VM_RESTART);
+    }
     else if (!strincmp(si.cp, "o", si.count))
     {
         stepOver(pVM);
     }
     else if (!strincmp(si.cp, "q", si.count))
     {
+        ficlTextOut(pVM, FICL_PROMPT, 0);
         vmThrow(pVM, VM_ABORT);
     }
+    else if (!strincmp(si.cp, "x", si.count))
+    {
+        /*
+        ** Take whatever's left in the TIB and feed it to a subordinate ficlExec
+        */ 
+        int ret;
+        char *cp = pVM->tib.cp + pVM->tib.index;
+        int count = pVM->tib.end - cp; 
+        FICL_WORD *oldRun = pVM->runningWord;
+
+        ret = ficlExecC(pVM, cp, count);
+
+        if (ret == VM_OUTOFTEXT)
+        {
+            ret = VM_RESTART;
+            pVM->runningWord = oldRun;
+            vmTextOut(pVM, "", 1);
+        }
+
+        vmThrow(pVM, ret);
+    }
     else
     {
         vmTextOut(pVM, "i -- step In", 1);
         vmTextOut(pVM, "o -- step Over", 1);
         vmTextOut(pVM, "g -- Go (execute to completion)", 1);
+        vmTextOut(pVM, "l -- List source code", 1);
         vmTextOut(pVM, "q -- Quit (stop debugging and abort)", 1);
-        vmTextOut(pVM, "x -- eXecute a single word", 1);
+        vmTextOut(pVM, "x -- eXecute the rest of the line as ficl words", 1);
+        debugPrompt(pVM);
         vmThrow(pVM, VM_RESTART);
     }
 
@@ -526,9 +609,10 @@ static void bye(FICL_VM *pVM)
 ** TOOLS 
 ** Display the parameter stack (code for ".s")
 **************************************************************************/
-static void displayStack(FICL_VM *pVM)
+static void displayPStack(FICL_VM *pVM)
 {
-    int d = stackDepth(pVM->pStack);
+    FICL_STACK *pStk = pVM->pStack;
+    int d = stackDepth(pStk);
     int i;
     CELL *pCell;
 
@@ -538,34 +622,58 @@ static void displayStack(FICL_VM *pVM)
         vmTextOut(pVM, "(Stack Empty) ", 0);
     else
     {
-        pCell = pVM->pStack->base;
+        pCell = pStk->base;
         for (i = 0; i < d; i++)
         {
             vmTextOut(pVM, ltoa((*pCell++).i, pVM->pad, pVM->base), 0);
             vmTextOut(pVM, " ", 0);
         }
     }
+    return;
 }
 
 
 static void displayRStack(FICL_VM *pVM)
 {
-    int d = stackDepth(pVM->rStack);
+    FICL_STACK *pStk = pVM->rStack;
+    int d = stackDepth(pStk);
     int i;
     CELL *pCell;
+    FICL_DICT *dp = vmGetDict(pVM);
+
+    vmCheckStack(pVM, 0, 0);
 
-    vmTextOut(pVM, "Return Stack: ", 0);
     if (d == 0)
-        vmTextOut(pVM, "Empty ", 0);
+        vmTextOut(pVM, "(Stack Empty) ", 0);
     else
     {
-        pCell = pVM->rStack->base;
+        pCell = pStk->base;
         for (i = 0; i < d; i++)
         {
-            vmTextOut(pVM, ultoa((*pCell++).i, pVM->pad, 16), 0);
+            CELL c = *pCell++;
+            /*
+            ** Attempt to find the word that contains the
+            ** stacked address (as if it is part of a colon definition).
+            ** If this works, print the name of the word. Otherwise print
+            ** the value as a number.
+            */
+            if (dictIncludes(dp, c.p))
+            {
+                FICL_WORD *pFW = findEnclosingWord(pVM, c.p);
+                if (pFW)
+                {
+                    int offset = (CELL *)c.p - &pFW->param[0];
+                    sprintf(pVM->pad, "%s+%d ", pFW->name, offset);
+                    vmTextOut(pVM, pVM->pad, 0);
+                    continue;  /* no need to print the numeric value */
+                }
+            }
+            vmTextOut(pVM, ltoa(c.i, pVM->pad, pVM->base), 0);
             vmTextOut(pVM, " ", 0);
         }
     }
+
+    return;
 }
 
 
@@ -575,7 +683,7 @@ static void displayRStack(FICL_VM *pVM)
 **************************************************************************/
 static void forgetWid(FICL_VM *pVM)
 {
-    FICL_DICT *pDict = ficlGetDict();
+    FICL_DICT *pDict = vmGetDict(pVM);
     FICL_HASH *pHash;
 
     pHash = (FICL_HASH *)stackPopPtr(pVM->pStack);
@@ -600,7 +708,7 @@ static void forgetWid(FICL_VM *pVM)
 static void forget(FICL_VM *pVM)
 {
     void *where;
-    FICL_DICT *pDict = ficlGetDict();
+    FICL_DICT *pDict = vmGetDict(pVM);
     FICL_HASH *pHash = pDict->pCompile;
 
     ficlTick(pVM);
@@ -619,7 +727,7 @@ static void forget(FICL_VM *pVM)
 #define nCOLWIDTH 8
 static void listWords(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     FICL_HASH *pHash = dp->pSearch[dp->nLists - 1];
     FICL_WORD *wp;
     int nChars = 0;
@@ -696,7 +804,7 @@ static void listWords(FICL_VM *pVM)
 **************************************************************************/
 static void listEnv(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetEnv();
+    FICL_DICT *dp = pVM->pSys->envp;
     FICL_HASH *pHash = dp->pForthWords;
     FICL_WORD *wp;
     unsigned i;
@@ -732,7 +840,7 @@ static void envConstant(FICL_VM *pVM)
 
     vmGetWordToPad(pVM);
     value = POPUNS();
-    ficlSetEnv(pVM->pad, (FICL_UNS)value);
+    ficlSetEnv(pVM->pSys, pVM->pad, (FICL_UNS)value);
     return;
 }
 
@@ -747,7 +855,7 @@ static void env2Constant(FICL_VM *pVM)
     vmGetWordToPad(pVM);
     v2 = POPUNS();
     v1 = POPUNS();
-    ficlSetEnvD(pVM->pad, v1, v2);
+    ficlSetEnvD(pVM->pSys, pVM->pad, v1, v2);
     return;
 }
 
@@ -765,8 +873,7 @@ void ficlCompileTools(FICL_SYSTEM *pSys)
     /*
     ** TOOLS and TOOLS EXT
     */
-    dictAppendWord(dp, ".r",        displayRStack,  FW_DEFAULT); /* guy carver */
-    dictAppendWord(dp, ".s",        displayStack,   FW_DEFAULT);
+    dictAppendWord(dp, ".s",        displayPStack,  FW_DEFAULT);
     dictAppendWord(dp, "bye",       bye,            FW_DEFAULT);
     dictAppendWord(dp, "forget",    forget,         FW_DEFAULT);
     dictAppendWord(dp, "see",       see,            FW_DEFAULT);
@@ -775,12 +882,13 @@ void ficlCompileTools(FICL_SYSTEM *pSys)
     /*
     ** Set TOOLS environment query values
     */
-    ficlSetEnv("tools",            FICL_TRUE);
-    ficlSetEnv("tools-ext",        FICL_FALSE);
+    ficlSetEnv(pSys, "tools",            FICL_TRUE);
+    ficlSetEnv(pSys, "tools-ext",        FICL_FALSE);
 
     /*
     ** Ficl extras
     */
+    dictAppendWord(dp, "r.s",       displayRStack,  FW_DEFAULT); /* guy carver */
     dictAppendWord(dp, ".env",      listEnv,        FW_DEFAULT);
     dictAppendWord(dp, "env-constant",
                                     envConstant,    FW_DEFAULT);
@@ -793,7 +901,6 @@ void ficlCompileTools(FICL_SYSTEM *pSys)
     dictAppendWord(dp, "step-break",stepBreak,      FW_DEFAULT);
     dictAppendWord(dp, "forget-wid",forgetWid,      FW_DEFAULT);
     dictAppendWord(dp, "see-xt",    seeXT,          FW_DEFAULT);
-    dictAppendWord(dp, ".r",        displayRStack,  FW_DEFAULT);
 
     return;
 }
diff --git a/sys/boot/ficl/vm.c b/sys/boot/ficl/vm.c
index bebba71..7bcb19a 100644
--- a/sys/boot/ficl/vm.c
+++ b/sys/boot/ficl/vm.c
@@ -3,7 +3,7 @@
 ** Forth Inspired Command Language - virtual machine methods
 ** Author: John Sadler (john_sadler@alum.mit.edu)
 ** Created: 19 July 1997
-** $Id: vm.c,v 1.8 2001-04-26 21:41:23-07 jsadler Exp jsadler $
+** $Id: vm.c,v 1.13 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** This file implements the virtual machine of FICL. Each virtual
@@ -18,6 +18,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -40,13 +45,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: vm.c,v 1.8 2001-04-26 21:41:23-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
@@ -165,6 +163,99 @@ void vmInnerLoop(FICL_VM *pVM)
     M_INNER_LOOP(pVM);
 }
 #endif
+#if 0
+/*
+** Recast inner loop that inlines tokens for control structures, arithmetic and stack operations, 
+** as well as create does> : ; and various literals
+*/
+typedef enum
+{
+    PATCH = 0,
+    L0,
+    L1,
+    L2,
+    LMINUS1,
+    LMINUS2,
+    DROP,
+    SWAP,
+    DUP,
+    PICK,
+    ROLL,
+    FETCH,
+    STORE,
+    BRANCH,
+    CBRANCH,
+    LEAVE,
+    TO_R,
+    R_FROM,
+    EXIT;
+} OPCODE;
+
+typedef CELL *IPTYPE;
+
+void vmInnerLoop(FICL_VM *pVM)
+{
+    IPTYPE ip = pVM->ip;
+    FICL_STACK *pStack = pVM->pStack;
+
+    for (;;)
+    {
+        OPCODE o = (*ip++).i;
+        CELL c;
+        switch (o)
+        {
+        case L0:
+            stackPushINT(pStack, 0);
+            break;
+        case L1:
+            stackPushINT(pStack, 1);
+            break;
+        case L2:
+            stackPushINT(pStack, 2);
+            break;
+        case LMINUS1:
+            stackPushINT(pStack, -1);
+            break;
+        case LMINUS2:
+            stackPushINT(pStack, -2);
+            break;
+        case DROP:
+            stackDrop(pStack, 1);
+            break;
+        case SWAP:
+            stackRoll(pStack, 1);
+            break;
+        case DUP:
+            stackPick(pStack, 0);
+            break;
+        case PICK:
+            c = *ip++;
+            stackPick(pStack, c.i);
+            break;
+        case ROLL:
+            c = *ip++;
+            stackRoll(pStack, c.i);
+            break;
+        case EXIT:
+            return;
+        }
+    }
+
+    return;
+}
+#endif
+
+
+
+/**************************************************************************
+                        v m G e t D i c t
+** Returns the address dictionary for this VM's system
+**************************************************************************/
+FICL_DICT  *vmGetDict(FICL_VM *pVM)
+{
+	assert(pVM);
+	return pVM->pSys->dp;
+}
 
 
 /**************************************************************************
@@ -440,18 +531,6 @@ void vmSetTextOut(FICL_VM *pVM, OUTFUNC textOut)
 
 
 /**************************************************************************
-                        v m S t e p
-** Single step the vm - equivalent to "step into" - used for debugging
-**************************************************************************/
-#if FICL_WANT_DEBUGGER
-void vmStep(FICL_VM *pVM)
-{
-    M_VM_STEP(pVM);
-}
-#endif
-
-
-/**************************************************************************
                         v m T e x t O u t
 ** Feeds text to the vm's output callback
 **************************************************************************/
diff --git a/sys/boot/ficl/words.c b/sys/boot/ficl/words.c
index 7888a86..2f50100 100644
--- a/sys/boot/ficl/words.c
+++ b/sys/boot/ficl/words.c
@@ -4,7 +4,7 @@
 ** ANS Forth CORE word-set written in C
 ** Author: John Sadler (john_sadler@alum.mit.edu)
 ** Created: 19 July 1997
-** $Id: words.c,v 1.11 2001-04-26 21:41:15-07 jsadler Exp jsadler $
+** $Id: words.c,v 1.17 2001/12/05 07:21:34 jsadler Exp $
 *******************************************************************/
 /*
 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -12,6 +12,11 @@
 **
 ** Get the latest Ficl release at http://ficl.sourceforge.net
 **
+** 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, please
+** contact me by email at the address above.
+**
 ** L I C E N S E  and  D I S C L A I M E R
 ** 
 ** Redistribution and use in source and binary forms, with or without
@@ -34,13 +39,6 @@
 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ** SUCH DAMAGE.
-**
-** 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, please send
-** contact me by email at the address above.
-**
-** $Id: words.c,v 1.11 2001-04-26 21:41:15-07 jsadler Exp jsadler $
 */
 
 /* $FreeBSD$ */
@@ -73,48 +71,9 @@ static char leaveTag[] = "leave";
 static char destTag[]  = "target";
 static char origTag[]  = "origin";
 
-/*
-** 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 *pTwoLitParen  = NULL;
-static FICL_WORD *pLoopParen    = NULL;
-static FICL_WORD *pPLoopParen   = NULL;
-static FICL_WORD *pPlusStore    = 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 *pGet2LocalParen= NULL;
-static FICL_WORD *pGetLocal0    = NULL;
-static FICL_WORD *pGetLocal1    = NULL;
-static FICL_WORD *pToLocalParen = NULL;
-static FICL_WORD *pTo2LocalParen = 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;
-static CELL *pMarkLocals = NULL;
-
 static void doLocalIm(FICL_VM *pVM);
 static void do2LocalIm(FICL_VM *pVM);
-
 #endif
 
 
@@ -162,7 +121,7 @@ static void matchControlTag(FICL_VM *pVM, char *tag)
 */
 static void resolveBackBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
 {
-    long offset;
+    FICL_INT offset;
     CELL *patchAddr;
 
     matchControlTag(pVM, tag);
@@ -185,7 +144,7 @@ static void resolveBackBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
 */
 static void resolveForwardBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
 {
-    long offset;
+    FICL_INT offset;
     CELL *patchAddr;
 
     matchControlTag(pVM, tag);
@@ -235,12 +194,15 @@ static void resolveAbsBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
 ** 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.
+** (jws 8/01) Trailing decimal point causes a zero cell to be pushed. (See
+** the standard for DOUBLE wordset.
 **************************************************************************/
 
 int ficlParseNumber(FICL_VM *pVM, STRINGINFO si)
 {
     FICL_INT accum  = 0;
     char isNeg      = FALSE;
+	char hasDP      = FALSE;
     unsigned base   = pVM->base;
     char *cp        = SI_PTR(si);
     FICL_COUNT count= (FICL_COUNT)SI_COUNT(si);
@@ -266,7 +228,13 @@ int ficlParseNumber(FICL_VM *pVM, STRINGINFO si)
         }
     }
 
-    if (count == 0)
+    if ((count > 0) && (cp[count-1] == '.')) /* detect & remove trailing decimal */
+    {
+        hasDP = TRUE;
+        count--;
+    }
+
+    if (count == 0)        /* detect "+", "-", ".", "+." etc */
         return FALSE;
 
     while ((count--) && ((ch = *cp++) != '\0'))
@@ -285,6 +253,9 @@ int ficlParseNumber(FICL_VM *pVM, STRINGINFO si)
         accum = accum * base + digit;
     }
 
+	if (hasDP)		/* simple (required) DOUBLE support */
+		PUSHINT(0);
+
     if (isNeg)
         accum = -accum;
 
@@ -486,7 +457,7 @@ static void mulDivRem(FICL_VM *pVM)
 
 static void colon(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     STRINGINFO si = vmGetWord(pVM);
 
     dictCheckThreshold(dp);
@@ -495,7 +466,7 @@ static void colon(FICL_VM *pVM)
     markControlTag(pVM, colonTag);
     dictAppendWord2(dp, si, colonParen, FW_DEFAULT | FW_SMUDGE);
 #if FICL_WANT_LOCALS
-    nLocals = 0;
+    pVM->pSys->nLocals = 0;
 #endif
     return;
 }
@@ -539,23 +510,23 @@ static void semiParen(FICL_VM *pVM)
 
 static void semicolonCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pSemiParen);
+    assert(pVM->pSys->pSemiParen);
     matchControlTag(pVM, colonTag);
 
 #if FICL_WANT_LOCALS
-    assert(pUnLinkParen);
-    if (nLocals > 0)
+    assert(pVM->pSys->pUnLinkParen);
+    if (pVM->pSys->nLocals > 0)
     {
-        FICL_DICT *pLoc = ficlGetLoc();
+        FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
         dictEmpty(pLoc, pLoc->pForthWords->size);
-        dictAppendCell(dp, LVALUEtoCELL(pUnLinkParen));
+        dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pUnLinkParen));
     }
-    nLocals = 0;
+    pVM->pSys->nLocals = 0;
 #endif
 
-    dictAppendCell(dp, LVALUEtoCELL(pSemiParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pSemiParen));
     pVM->state = INTERPRET;
     dictUnsmudge(dp);
     return;
@@ -579,17 +550,17 @@ static void exitParen(FICL_VM *pVM)
 
 static void exitCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
-    assert(pExitParen);
+    FICL_DICT *dp = vmGetDict(pVM);
+    assert(pVM->pSys->pExitParen);
     IGNORE(pVM);
 
 #if FICL_WANT_LOCALS
-    if (nLocals > 0)
+    if (pVM->pSys->nLocals > 0)
     {
-        dictAppendCell(dp, LVALUEtoCELL(pUnLinkParen));
+        dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pUnLinkParen));
     }
 #endif
-    dictAppendCell(dp, LVALUEtoCELL(pExitParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pExitParen));
     return;
 }
 
@@ -632,7 +603,7 @@ void twoConstParen(FICL_VM *pVM)
 
 static void constant(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     STRINGINFO si = vmGetWord(pVM);
 
 #if FICL_ROBUST > 1
@@ -646,7 +617,7 @@ static void constant(FICL_VM *pVM)
 
 static void twoConstant(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     STRINGINFO si = vmGetWord(pVM);
     CELL c;
     
@@ -709,6 +680,172 @@ static void hexDot(FICL_VM *pVM)
 
 
 /**************************************************************************
+                        s t r l e n
+** FICL   ( c-string -- length )
+**
+** Returns the length of a C-style (zero-terminated) string.
+**
+** --lch
+**/
+static void ficlStrlen(FICL_VM *ficlVM)
+	{
+	char *address = (char *)stackPopPtr(ficlVM->pStack);
+	stackPushINT(ficlVM->pStack, strlen(address));
+	}
+
+
+/**************************************************************************
+                        s p r i n t f
+** FICL   ( i*x c-addr-fmt u-fmt c-addr-buffer u-buffer -- c-addr-buffer u-written success-flag )
+** Similar to the C sprintf() function.  It formats into a buffer based on
+** a "format" string.  Each character in the format string is copied verbatim
+** to the output buffer, until SPRINTF encounters a percent sign ("%").
+** SPRINTF then skips the percent sign, and examines the next character
+** (the "format character").  Here are the valid format characters:
+**    s - read a C-ADDR U-LENGTH string from the stack and copy it to
+**        the buffer
+**    d - read a cell from the stack, format it as a string (base-10,
+**        signed), and copy it to the buffer
+**    x - same as d, except in base-16
+**    u - same as d, but unsigned
+**    % - output a literal percent-sign to the buffer
+** SPRINTF returns the c-addr-buffer argument unchanged, the number of bytes
+** written, and a flag indicating whether or not it ran out of space while
+** writing to the output buffer (TRUE if it ran out of space).
+**
+** If SPRINTF runs out of space in the buffer to store the formatted string,
+** it still continues parsing, in an effort to preserve your stack (otherwise
+** it might leave uneaten arguments behind).
+**
+** --lch
+**************************************************************************/
+static void ficlSprintf(FICL_VM *pVM) /*  */
+{
+	int bufferLength = stackPopINT(pVM->pStack);
+	char *buffer = (char *)stackPopPtr(pVM->pStack);
+	char *bufferStart = buffer;
+
+	int formatLength = stackPopINT(pVM->pStack);
+	char *format = (char *)stackPopPtr(pVM->pStack);
+	char *formatStop = format + formatLength;
+
+	int base = 10;
+	int unsignedInteger = FALSE;
+
+	int append = FICL_TRUE;
+
+	while (format < formatStop)
+	{
+		char scratch[64];
+		char *source;
+		int actualLength;
+		int desiredLength;
+		int leadingZeroes;
+
+
+		if (*format != '%')
+		{
+			source = format;
+			actualLength = desiredLength = 1;
+			leadingZeroes = 0;
+		}
+		else
+		{
+			format++;
+			if (format == formatStop)
+				break;
+
+			leadingZeroes = (*format == '0');
+			if (leadingZeroes)
+				{
+				format++;
+				if (format == formatStop)
+					break;
+				}
+
+			desiredLength = isdigit(*format);
+			if (desiredLength)
+				{
+				desiredLength = strtol(format, &format, 10);
+				if (format == formatStop)
+					break;
+				}
+			else if (*format == '*')
+				{
+				desiredLength = stackPopINT(pVM->pStack);
+				format++;
+				if (format == formatStop)
+					break;
+				}
+
+
+			switch (*format)
+			{
+				case 's':
+				case 'S':
+				{
+					actualLength = stackPopINT(pVM->pStack);
+					source = (char *)stackPopPtr(pVM->pStack);
+					break;
+				}
+				case 'x':
+				case 'X':
+					base = 16;
+				case 'u':
+				case 'U':
+					unsignedInteger = TRUE;
+				case 'd':
+				case 'D':
+				{
+					int integer = stackPopINT(pVM->pStack);
+					if (unsignedInteger)
+						ultoa(integer, scratch, base);
+					else
+						ltoa(integer, scratch, base);
+					base = 10;
+					unsignedInteger = FALSE;
+					source = scratch;
+					actualLength = strlen(scratch);
+					break;
+				}
+				case '%':
+					source = format;
+					actualLength = 1;
+				default:
+					continue;
+			}
+		}
+
+		if (append == FICL_TRUE)
+		{
+			if (!desiredLength)
+				desiredLength = actualLength;
+			if (desiredLength > bufferLength)
+			{
+				append = FICL_FALSE;
+				desiredLength = bufferLength;
+			}
+			while (desiredLength > actualLength)
+				{
+				*buffer++ = (char)((leadingZeroes) ? '0' : ' ');
+				bufferLength--;
+				desiredLength--;
+				}
+			memcpy(buffer, source, actualLength);
+			buffer += actualLength;
+			bufferLength -= actualLength;
+		}
+
+		format++;
+	}
+
+	stackPushPtr(pVM->pStack, bufferStart);
+	stackPushINT(pVM->pStack, buffer - bufferStart);
+	stackPushINT(pVM->pStack, append);
+}
+
+
+/**************************************************************************
                         d u p   &   f r i e n d s
 ** 
 **************************************************************************/
@@ -1092,11 +1229,11 @@ static void cStore(FICL_VM *pVM)
 
 static void ifCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pIfParen);
+    assert(pVM->pSys->pIfParen);
 
-    dictAppendCell(dp, LVALUEtoCELL(pIfParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pIfParen));
     markBranch(dp, pVM, origTag);
     dictAppendUNS(dp, 1);
     return;
@@ -1148,11 +1285,11 @@ static void elseCoIm(FICL_VM *pVM)
 {
     CELL *patchAddr;
     FICL_INT offset;
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pBranchParen);
+    assert(pVM->pSys->pBranchParen);
                                             /* (1) compile branch runtime */
-    dictAppendCell(dp, LVALUEtoCELL(pBranchParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranchParen));
     matchControlTag(pVM, origTag);
     patchAddr = 
         (CELL *)stackPopPtr(pVM->pStack);   /* (2) pop "if" patch addr */
@@ -1186,7 +1323,7 @@ static void branchParen(FICL_VM *pVM)
 
 static void endifCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     resolveForwardBranch(dp, pVM, origTag);
     return;
 }
@@ -1234,6 +1371,7 @@ static void interpret(FICL_VM *pVM)
     FICL_SYSTEM *pSys;
 
     assert(pVM);
+
     pSys = pVM->pSys;
     si   = vmGetWord0(pVM);
 
@@ -1258,14 +1396,25 @@ static void interpret(FICL_VM *pVM)
     for (i=0; i < FICL_MAX_PARSE_STEPS; i++)
     {
         FICL_WORD *pFW = pSys->parseList[i];
-        FICL_PARSE_STEP pStep;
            
         if (pFW == NULL)
             break;
 
-        pStep = (FICL_PARSE_STEP)(pFW->param->fn);
-        if ((*pStep)(pVM, si))
-            return;
+        if (pFW->code == parseStepParen)
+        {
+            FICL_PARSE_STEP pStep;
+            pStep = (FICL_PARSE_STEP)(pFW->param->fn);
+            if ((*pStep)(pVM, si))
+                return;
+        }
+        else
+        {
+            stackPushPtr(pVM->pStack, SI_PTR(si));
+            stackPushUNS(pVM->pStack, SI_COUNT(si));
+            ficlExecXT(pVM, pFW);
+            if (stackPopINT(pVM->pStack))
+                return;
+        }
     }
 
     i = SI_COUNT(si);
@@ -1297,7 +1446,7 @@ static void interpret(FICL_VM *pVM)
 **************************************************************************/
 static int ficlParseWord(FICL_VM *pVM, STRINGINFO si)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     FICL_WORD *tempFW;
 
 #if FICL_ROBUST
@@ -1306,9 +1455,9 @@ static int ficlParseWord(FICL_VM *pVM, STRINGINFO si)
 #endif
 
 #if FICL_WANT_LOCALS
-    if (nLocals > 0)
+    if (pVM->pSys->nLocals > 0)
     {
-        tempFW = dictLookupLoc(dp, si);
+        tempFW = ficlLookupLoc(pVM->pSys, si);
     }
     else
 #endif
@@ -1348,6 +1497,20 @@ static int ficlParseWord(FICL_VM *pVM, STRINGINFO si)
 }
 
 
+/*
+** Surrogate precompiled parse step for ficlParseWord (this step is hard coded in 
+** INTERPRET)
+*/
+static void lookup(FICL_VM *pVM)
+{
+    STRINGINFO si;
+    SI_SETLEN(si, stackPopUNS(pVM->pStack));
+    SI_SETPTR(si, stackPopPtr(pVM->pStack));
+    stackPushINT(pVM->pStack, ficlParseWord(pVM, si));
+    return;
+}
+
+
 /**************************************************************************
                         p a r e n P a r s e S t e p
 ** (parse-step)  ( c-addr u -- flag )
@@ -1374,11 +1537,12 @@ void parseStepParen(FICL_VM *pVM)
 static void addParseStep(FICL_VM *pVM)
 {
     FICL_WORD *pStep;
+    FICL_DICT *pd = vmGetDict(pVM);
 #if FICL_ROBUST > 1
     vmCheckStack(pVM, 1, 0);
 #endif
     pStep = (FICL_WORD *)(stackPop(pVM->pStack).p);
-    if ((pStep != NULL) && isAFiclWord(pStep))
+    if ((pStep != NULL) && isAFiclWord(pd, pStep))
         ficlAddParseStep(pVM->pSys, pStep);
     return;
 }
@@ -1425,10 +1589,10 @@ static void twoLitParen(FICL_VM *pVM)
 
 static void literalIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
-    assert(pLitParen);
+    FICL_DICT *dp = vmGetDict(pVM);
+    assert(pVM->pSys->pLitParen);
 
-    dictAppendCell(dp, LVALUEtoCELL(pLitParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pLitParen));
     dictAppendCell(dp, stackPop(pVM->pStack));
 
     return;
@@ -1437,10 +1601,10 @@ static void literalIm(FICL_VM *pVM)
 
 static void twoLiteralIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
-    assert(pTwoLitParen);
+    FICL_DICT *dp = vmGetDict(pVM);
+    assert(pVM->pSys->pTwoLitParen);
 
-    dictAppendCell(dp, LVALUEtoCELL(pTwoLitParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pTwoLitParen));
     dictAppendCell(dp, stackPop(pVM->pStack));
     dictAppendCell(dp, stackPop(pVM->pStack));
 
@@ -1609,11 +1773,11 @@ static void bitwiseNot(FICL_VM *pVM)
 
 static void doCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pDoParen);
+    assert(pVM->pSys->pDoParen);
 
-    dictAppendCell(dp, LVALUEtoCELL(pDoParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pDoParen));
     /*
     ** Allot space for a pointer to the end
     ** of the loop - "leave" uses this...
@@ -1649,11 +1813,11 @@ static void doParen(FICL_VM *pVM)
 
 static void qDoCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pQDoParen);
+    assert(pVM->pSys->pQDoParen);
 
-    dictAppendCell(dp, LVALUEtoCELL(pQDoParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pQDoParen));
     /*
     ** Allot space for a pointer to the end
     ** of the loop - "leave" uses this...
@@ -1719,11 +1883,11 @@ static void unloopCo(FICL_VM *pVM)
 
 static void loopCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pLoopParen);
+    assert(pVM->pSys->pLoopParen);
 
-    dictAppendCell(dp, LVALUEtoCELL(pLoopParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pLoopParen));
     resolveBackBranch(dp, pVM, doTag);
     resolveAbsBranch(dp, pVM, leaveTag);
     return;
@@ -1732,11 +1896,11 @@ static void loopCoIm(FICL_VM *pVM)
 
 static void plusLoopCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pPLoopParen);
+    assert(pVM->pSys->pPLoopParen);
 
-    dictAppendCell(dp, LVALUEtoCELL(pPLoopParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pPLoopParen));
     resolveBackBranch(dp, pVM, doTag);
     resolveAbsBranch(dp, pVM, leaveTag);
     return;
@@ -1767,18 +1931,18 @@ static void loopParen(FICL_VM *pVM)
 
 static void plusLoopParen(FICL_VM *pVM)
 {
-	FICL_INT index,limit,increment;
-	int flag;
+    FICL_INT index,limit,increment;
+    int flag;
 
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 0);
+    vmCheckStack(pVM, 1, 0);
 #endif
 
-	index = stackGetTop(pVM->rStack).i;
-	limit = stackFetch(pVM->rStack, 1).i;
-	increment = POP().i;
-	
-	index += increment;
+    index = stackGetTop(pVM->rStack).i;
+    limit = stackFetch(pVM->rStack, 1).i;
+    increment = POP().i;
+    
+    index += increment;
 
     if (increment < 0)
         flag = (index < limit);
@@ -1834,28 +1998,28 @@ static void loopKCo(FICL_VM *pVM)
 static void toRStack(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 0);
+    vmCheckStack(pVM, 1, 0);
 #endif
 
-	stackPush(pVM->rStack, POP());
+    stackPush(pVM->rStack, POP());
 }
 
 static void fromRStack(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 1);
+    vmCheckStack(pVM, 0, 1);
 #endif
 
-	PUSH(stackPop(pVM->rStack));
+    PUSH(stackPop(pVM->rStack));
 }
 
 static void fetchRStack(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 1);
+    vmCheckStack(pVM, 0, 1);
 #endif
 
-	PUSH(stackGetTop(pVM->rStack));
+    PUSH(stackGetTop(pVM->rStack));
 }
 
 static void twoToR(FICL_VM *pVM)
@@ -1898,19 +2062,19 @@ static void twoRFetch(FICL_VM *pVM)
 
 static void variableParen(FICL_VM *pVM)
 {
-	FICL_WORD *fw;
+    FICL_WORD *fw;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 1);
+    vmCheckStack(pVM, 0, 1);
 #endif
 
-	fw = pVM->runningWord;
-	PUSHPTR(fw->param);
+    fw = pVM->runningWord;
+    PUSHPTR(fw->param);
 }
 
 
 static void variable(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     STRINGINFO si = vmGetWord(pVM);
 
     dictAppendWord2(dp, si, variableParen, FW_DEFAULT);
@@ -1921,7 +2085,7 @@ static void variable(FICL_VM *pVM)
 
 static void twoVariable(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     STRINGINFO si = vmGetWord(pVM);
 
     dictAppendWord2(dp, si, variableParen, FW_DEFAULT);
@@ -1937,13 +2101,14 @@ static void twoVariable(FICL_VM *pVM)
 
 static void base(FICL_VM *pVM)
 {
-	CELL *pBase;
+    CELL *pBase;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 1);
+    vmCheckStack(pVM, 0, 1);
 #endif
 
-	pBase = (CELL *)(&pVM->base);
-	PUSHPTR(pBase);
+    pBase = (CELL *)(&pVM->base);
+    stackPush(pVM->pStack, LVALUEtoCELL(pBase));
+    return;
 }
 
 
@@ -1968,85 +2133,85 @@ static void hex(FICL_VM *pVM)
 
 static void allot(FICL_VM *pVM)
 {
-	FICL_DICT *dp;
-	FICL_INT i;
+    FICL_DICT *dp;
+    FICL_INT i;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 0);
+    vmCheckStack(pVM, 1, 0);
 #endif
 
-	dp = ficlGetDict();
-	i = POPINT();
+    dp = vmGetDict(pVM);
+    i = POPINT();
 
 #if FICL_ROBUST
-	dictCheck(dp, pVM, i);
+    dictCheck(dp, pVM, i);
 #endif
 
-	dictAllot(dp, i);
+    dictAllot(dp, i);
     return;
 }
 
 
 static void here(FICL_VM *pVM)
 {
-	FICL_DICT *dp;
+    FICL_DICT *dp;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 1);
+    vmCheckStack(pVM, 0, 1);
 #endif
 
-	dp = ficlGetDict();
-	PUSHPTR(dp->here);
+    dp = vmGetDict(pVM);
+    PUSHPTR(dp->here);
     return;
 }
 
 static void comma(FICL_VM *pVM)
 {
-	FICL_DICT *dp;
-	CELL c;
+    FICL_DICT *dp;
+    CELL c;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 0);
+    vmCheckStack(pVM, 1, 0);
 #endif
 
-	dp = ficlGetDict();
-	c = POP();
-	dictAppendCell(dp, c);
+    dp = vmGetDict(pVM);
+    c = POP();
+    dictAppendCell(dp, c);
     return;
 }
 
 static void cComma(FICL_VM *pVM)
 {
-	FICL_DICT *dp;
-	char c;
+    FICL_DICT *dp;
+    char c;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 0);
+    vmCheckStack(pVM, 1, 0);
 #endif
 
-	dp = ficlGetDict();
-	c = (char)POPINT();
-	dictAppendChar(dp, c);
+    dp = vmGetDict(pVM);
+    c = (char)POPINT();
+    dictAppendChar(dp, c);
     return;
 }
 
 static void cells(FICL_VM *pVM)
 {
-	FICL_INT i;
+    FICL_INT i;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 1);
+    vmCheckStack(pVM, 1, 1);
 #endif
 
-	i = POPINT();
-	PUSHINT(i * (FICL_INT)sizeof (CELL));
+    i = POPINT();
+    PUSHINT(i * (FICL_INT)sizeof (CELL));
     return;
 }
 
 static void cellPlus(FICL_VM *pVM)
 {
-	char *cp;
+    char *cp;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 1);
+    vmCheckStack(pVM, 1, 1);
 #endif
 
-	cp = POPPTR();
-	PUSHPTR(cp + sizeof (CELL));
+    cp = POPPTR();
+    PUSHPTR(cp + sizeof (CELL));
     return;
 }
 
@@ -2061,19 +2226,19 @@ static void cellPlus(FICL_VM *pVM)
 **************************************************************************/
 void ficlTick(FICL_VM *pVM)
 {
-	FICL_WORD *pFW = NULL;
-	STRINGINFO si = vmGetWord(pVM);
+    FICL_WORD *pFW = NULL;
+    STRINGINFO si = vmGetWord(pVM);
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 1);
+    vmCheckStack(pVM, 0, 1);
 #endif
 
-	pFW = dictLookup(ficlGetDict(), si);
-	if (!pFW)
-	{
-		int i = SI_COUNT(si);
-		vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
-	}
-	PUSHPTR(pFW);
+    pFW = dictLookup(vmGetDict(pVM), si);
+    if (!pFW)
+    {
+        int i = SI_COUNT(si);
+        vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
+    }
+    PUSHPTR(pFW);
     return;
 }
 
@@ -2096,8 +2261,9 @@ static void bracketTickCoIm(FICL_VM *pVM)
 
 static void postponeCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp  = ficlGetDict();
+    FICL_DICT *dp  = vmGetDict(pVM);
     FICL_WORD *pFW;
+    FICL_WORD *pComma = ficlLookup(pVM->pSys, ",");
     assert(pComma);
 
     ficlTick(pVM);
@@ -2147,7 +2313,7 @@ static void execute(FICL_VM *pVM)
 static void immediate(FICL_VM *pVM)
 {
     IGNORE(pVM);
-    dictSetImmediate(ficlGetDict());
+    dictSetImmediate(vmGetDict(pVM));
     return;
 }
 
@@ -2155,11 +2321,64 @@ static void immediate(FICL_VM *pVM)
 static void compileOnly(FICL_VM *pVM)
 {
     IGNORE(pVM);
-    dictSetFlags(ficlGetDict(), FW_COMPILE, 0);
+    dictSetFlags(vmGetDict(pVM), FW_COMPILE, 0);
+    return;
+}
+
+
+static void setObjectFlag(FICL_VM *pVM)
+{
+    IGNORE(pVM);
+    dictSetFlags(vmGetDict(pVM), FW_ISOBJECT, 0);
+    return;
+}
+
+static void isObject(FICL_VM *pVM)
+{
+    int flag;
+    FICL_WORD *pFW = (FICL_WORD *)stackPopPtr(pVM->pStack);
+    
+    flag = ((pFW != NULL) && (pFW->flags & FW_ISOBJECT)) ? FICL_TRUE : FICL_FALSE;
+    stackPushINT(pVM->pStack, flag);
+    return;
+}
+
+static void cstringLit(FICL_VM *pVM)
+{
+    FICL_STRING *sp = (FICL_STRING *)(pVM->ip);
+
+    char *cp = sp->text;
+    cp += sp->count + 1;
+    cp = alignPtr(cp);
+    pVM->ip = (IPTYPE)(void *)cp;
+
+    stackPushPtr(pVM->pStack, sp);
     return;
 }
 
 
+static void cstringQuoteIm(FICL_VM *pVM)
+{
+    FICL_DICT *dp = vmGetDict(pVM);
+
+    if (pVM->state == INTERPRET)
+    {
+        FICL_STRING *sp = (FICL_STRING *) dp->here;
+        vmGetString(pVM, sp, '\"');
+        stackPushPtr(pVM->pStack, sp);
+		/* move HERE past string so it doesn't get overwritten.  --lch */
+		dictAllot(dp, sp->count + sizeof(FICL_COUNT));
+    }
+    else    /* COMPILE state */
+    {
+        dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pCStringLit));
+        dp->here = PTRtoCELL vmGetString(pVM, (FICL_STRING *)dp->here, '\"');
+        dictAlign(dp);
+    }
+
+    return;
+}
+
 /**************************************************************************
                         d o t Q u o t e
 ** IMMEDIATE word that compiles a string literal for later display
@@ -2173,27 +2392,29 @@ static void compileOnly(FICL_VM *pVM)
 
 static void stringLit(FICL_VM *pVM)
 {
-	FICL_STRING *sp;
-	FICL_COUNT count;
-	char *cp;
+    FICL_STRING *sp;
+    FICL_COUNT count;
+    char *cp;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 2);
+    vmCheckStack(pVM, 0, 2);
 #endif
 
-	sp = (FICL_STRING *)(pVM->ip);
-	count = sp->count;
-	cp = sp->text;
-	PUSHPTR(cp);
-	PUSHUNS(count);
-	cp += count + 1;
-	cp = alignPtr(cp);
-	pVM->ip = (IPTYPE)(void *)cp;
+    sp = (FICL_STRING *)(pVM->ip);
+    count = sp->count;
+    cp = sp->text;
+    PUSHPTR(cp);
+    PUSHUNS(count);
+    cp += count + 1;
+    cp = alignPtr(cp);
+    pVM->ip = (IPTYPE)(void *)cp;
 }
 
 static void dotQuoteCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
-    dictAppendCell(dp, LVALUEtoCELL(pStringLit));
+    FICL_DICT *dp = vmGetDict(pVM);
+    FICL_WORD *pType = ficlLookup(pVM->pSys, "type");
+    assert(pType);
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pStringLit));
     dp->here = PTRtoCELL vmGetString(pVM, (FICL_STRING *)dp->here, '\"');
     dictAlign(dp);
     dictAppendCell(dp, LVALUEtoCELL(pType));
@@ -2238,19 +2459,19 @@ static void dotParen(FICL_VM *pVM)
 **************************************************************************/
 static void sLiteralCoIm(FICL_VM *pVM)
 {
-	FICL_DICT *dp;
-	char *cp, *cpDest;
-	FICL_UNS u;
+    FICL_DICT *dp;
+    char *cp, *cpDest;
+    FICL_UNS u;
 
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 2, 0);
+    vmCheckStack(pVM, 2, 0);
 #endif
 
-	dp = ficlGetDict();
-	u  = POPUNS();
-	cp = POPPTR();
+    dp = vmGetDict(pVM);
+    u  = POPUNS();
+    cp = POPPTR();
 
-    dictAppendCell(dp, LVALUEtoCELL(pStringLit));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pStringLit));
     cpDest    = (char *) dp->here;
     *cpDest++ = (char)   u;
 
@@ -2273,7 +2494,7 @@ static void sLiteralCoIm(FICL_VM *pVM)
 static void state(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 1);
+    vmCheckStack(pVM, 0, 1);
 #endif
     PUSHPTR(&pVM->state);
     return;
@@ -2289,21 +2510,21 @@ static void state(FICL_VM *pVM)
 
 static void createParen(FICL_VM *pVM)
 {
-	CELL *pCell;
+    CELL *pCell;
 
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 1);
+    vmCheckStack(pVM, 0, 1);
 #endif
 
-	pCell = pVM->runningWord->param;
-	PUSHPTR(pCell+1);
+    pCell = pVM->runningWord->param;
+    PUSHPTR(pCell+1);
     return;
 }
 
 
 static void create(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     STRINGINFO si = vmGetWord(pVM);
 
     dictCheckThreshold(dp);
@@ -2316,23 +2537,23 @@ static void create(FICL_VM *pVM)
 
 static void doDoes(FICL_VM *pVM)
 {
-	CELL *pCell;
-	IPTYPE tempIP;
+    CELL *pCell;
+    IPTYPE tempIP;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 0, 1);
+    vmCheckStack(pVM, 0, 1);
 #endif
 
-	pCell = pVM->runningWord->param;
-	tempIP = (IPTYPE)((*pCell).p);
-	PUSHPTR(pCell+1);
-	vmPushIP(pVM, tempIP);
+    pCell = pVM->runningWord->param;
+    tempIP = (IPTYPE)((*pCell).p);
+    PUSHPTR(pCell+1);
+    vmPushIP(pVM, tempIP);
     return;
 }
 
 
 static void doesParen(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     dp->smudge->code = doDoes;
     dp->smudge->param[0] = LVALUEtoCELL(pVM->ip);
     vmPopIP(pVM);
@@ -2342,21 +2563,21 @@ static void doesParen(FICL_VM *pVM)
 
 static void doesCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 #if FICL_WANT_LOCALS
-    assert(pUnLinkParen);
-    if (nLocals > 0)
+    assert(pVM->pSys->pUnLinkParen);
+    if (pVM->pSys->nLocals > 0)
     {
-        FICL_DICT *pLoc = ficlGetLoc();
+        FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
         dictEmpty(pLoc, pLoc->pForthWords->size);
-        dictAppendCell(dp, LVALUEtoCELL(pUnLinkParen));
+        dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pUnLinkParen));
     }
 
-    nLocals = 0;
+    pVM->pSys->nLocals = 0;
 #endif
     IGNORE(pVM);
 
-    dictAppendCell(dp, LVALUEtoCELL(pDoesParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pDoesParen));
     return;
 }
 
@@ -2369,14 +2590,14 @@ static void doesCoIm(FICL_VM *pVM)
 **************************************************************************/
 static void toBody(FICL_VM *pVM)
 {
-	FICL_WORD *pFW;
+    FICL_WORD *pFW;
 /*#$-GUY CHANGE: Added robustness.-$#*/
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 1);
+    vmCheckStack(pVM, 1, 1);
 #endif
 
-	pFW = POPPTR();
-	PUSHPTR(pFW->param + 1);
+    pFW = POPPTR();
+    PUSHPTR(pFW->param + 1);
     return;
 }
 
@@ -2387,13 +2608,13 @@ static void toBody(FICL_VM *pVM)
 */
 static void fromBody(FICL_VM *pVM)
 {
-	char *ptr;
+    char *ptr;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 1);
+    vmCheckStack(pVM, 1, 1);
 #endif
 
-	ptr = (char *)POPPTR() - sizeof (FICL_WORD);
-	PUSHPTR(ptr);
+    ptr = (char *)POPPTR() - sizeof (FICL_WORD);
+    PUSHPTR(ptr);
     return;
 }
 
@@ -2405,21 +2626,21 @@ static void fromBody(FICL_VM *pVM)
 */
 static void toName(FICL_VM *pVM)
 {
-	FICL_WORD *pFW;
+    FICL_WORD *pFW;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 2);
+    vmCheckStack(pVM, 1, 2);
 #endif
 
-	pFW = POPPTR();
-	PUSHPTR(pFW->name);
-	PUSHUNS(pFW->nName);
+    pFW = POPPTR();
+    PUSHPTR(pFW->name);
+    PUSHUNS(pFW->nName);
     return;
 }
 
 
 static void getLastWord(FICL_VM *pVM)
 {
-    FICL_DICT *pDict = ficlGetDict();
+    FICL_DICT *pDict = vmGetDict(pVM);
     FICL_WORD *wp = pDict->smudge;
     assert(wp);
     vmPush(pVM, LVALUEtoCELL(wp));
@@ -2470,18 +2691,18 @@ static void lessNumberSign(FICL_VM *pVM)
 */
 static void numberSign(FICL_VM *pVM)
 {
-	FICL_STRING *sp;
-	DPUNS u;
-	UNS16 rem;
+    FICL_STRING *sp;
+    DPUNS u;
+    UNS16 rem;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 2, 2);
+    vmCheckStack(pVM, 2, 2);
 #endif
 
-	sp = PTRtoSTRING pVM->pad;
-	u = u64Pop(pVM->pStack);
-	rem = m64UMod(&u, (UNS16)(pVM->base));
-	sp->text[sp->count++] = digit_to_char(rem);
-	u64Push(pVM->pStack, u);
+    sp = PTRtoSTRING pVM->pad;
+    u = u64Pop(pVM->pStack);
+    rem = m64UMod(&u, (UNS16)(pVM->base));
+    sp->text[sp->count++] = digit_to_char(rem);
+    u64Push(pVM->pStack, u);
     return;
 }
 
@@ -2493,17 +2714,17 @@ static void numberSign(FICL_VM *pVM)
 */
 static void numberSignGreater(FICL_VM *pVM)
 {
-	FICL_STRING *sp;
+    FICL_STRING *sp;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 2, 2);
+    vmCheckStack(pVM, 2, 2);
 #endif
 
-	sp = PTRtoSTRING pVM->pad;
-	sp->text[sp->count] = 0;
-	strrev(sp->text);
-	DROP(2);
-	PUSHPTR(sp->text);
-	PUSHUNS(sp->count);
+    sp = PTRtoSTRING pVM->pad;
+    sp->text[sp->count] = 0;
+    strrev(sp->text);
+    DROP(2);
+    PUSHPTR(sp->text);
+    PUSHUNS(sp->count);
     return;
 }
 
@@ -2516,24 +2737,24 @@ static void numberSignGreater(FICL_VM *pVM)
 */
 static void numberSignS(FICL_VM *pVM)
 {
-	FICL_STRING *sp;
-	DPUNS u;
-	UNS16 rem;
+    FICL_STRING *sp;
+    DPUNS u;
+    UNS16 rem;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 2, 2);
+    vmCheckStack(pVM, 2, 2);
 #endif
 
-	sp = PTRtoSTRING pVM->pad;
-	u = u64Pop(pVM->pStack);
+    sp = PTRtoSTRING pVM->pad;
+    u = u64Pop(pVM->pStack);
 
-	do 
-	{
-		rem = m64UMod(&u, (UNS16)(pVM->base));
-		sp->text[sp->count++] = digit_to_char(rem);
-	}
-	while (u.hi || u.lo);
+    do 
+    {
+        rem = m64UMod(&u, (UNS16)(pVM->base));
+        sp->text[sp->count++] = digit_to_char(rem);
+    }
+    while (u.hi || u.lo);
 
-	u64Push(pVM->pStack, u);
+    u64Push(pVM->pStack, u);
     return;
 }
 
@@ -2544,15 +2765,15 @@ static void numberSignS(FICL_VM *pVM)
 */
 static void hold(FICL_VM *pVM)
 {
-	FICL_STRING *sp;
-	int i;
+    FICL_STRING *sp;
+    int i;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 0);
+    vmCheckStack(pVM, 1, 0);
 #endif
 
-	sp = PTRtoSTRING pVM->pad;
-	i = POPINT();
-	sp->text[sp->count++] = (char) i;
+    sp = PTRtoSTRING pVM->pad;
+    i = POPINT();
+    sp->text[sp->count++] = (char) i;
     return;
 }
 
@@ -2564,16 +2785,16 @@ static void hold(FICL_VM *pVM)
 */
 static void sign(FICL_VM *pVM)
 {
-	FICL_STRING *sp;
-	int i;
+    FICL_STRING *sp;
+    int i;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM, 1, 0);
+    vmCheckStack(pVM, 1, 0);
 #endif
 
-	sp = PTRtoSTRING pVM->pad;
-	i = POPINT();
-	if (i < 0)
-		sp->text[sp->count++] = '-';
+    sp = PTRtoSTRING pVM->pad;
+    i = POPINT();
+    if (i < 0)
+        sp->text[sp->count++] = '-';
     return;
 }
 
@@ -2594,19 +2815,19 @@ static void sign(FICL_VM *pVM)
 **************************************************************************/
 static void toNumber(FICL_VM *pVM)
 {
-	FICL_UNS count;
-	char *cp;
-	DPUNS accum;
-	FICL_UNS base = pVM->base;
-	FICL_UNS ch;
-	FICL_UNS digit;
+    FICL_UNS count;
+    char *cp;
+    DPUNS accum;
+    FICL_UNS base = pVM->base;
+    FICL_UNS ch;
+    FICL_UNS digit;
 
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,4,4);
+    vmCheckStack(pVM,4,4);
 #endif
 
-	count = POPUNS();
-	cp = (char *)POPPTR();
+    count = POPUNS();
+    cp = (char *)POPPTR();
     accum = u64Pop(pVM->pStack);
 
     for (ch = *cp; count > 0; ch = *++cp, count--)
@@ -2687,17 +2908,17 @@ static void ficlAbort(FICL_VM *pVM)
 **************************************************************************/
 static void accept(FICL_VM *pVM)
 {
-	FICL_UNS count, len;
-	char *cp;
-	char *pBuf, *pEnd;
+    FICL_UNS count, len;
+    char *cp;
+    char *pBuf, *pEnd;
 
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,1);
+    vmCheckStack(pVM,2,1);
 #endif
 
-	pBuf = vmGetInBuf(pVM);
+    pBuf = vmGetInBuf(pVM);
     pEnd = vmGetInBufEnd(pVM);
-	len = pEnd - pBuf;
+    len = pEnd - pBuf;
     if (len == 0)
         vmThrow(pVM, VM_RESTART);
 
@@ -2725,7 +2946,7 @@ static void accept(FICL_VM *pVM)
 **************************************************************************/
 static void align(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     IGNORE(pVM);
     dictAlign(dp);
     return;
@@ -2738,13 +2959,13 @@ static void align(FICL_VM *pVM)
 **************************************************************************/
 static void aligned(FICL_VM *pVM)
 {
-	void *addr;
+    void *addr;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,1,1);
+    vmCheckStack(pVM,1,1);
 #endif
 
-	addr = POPPTR();
-	PUSHPTR(alignPtr(addr));
+    addr = POPPTR();
+    PUSHPTR(alignPtr(addr));
     return;
 }
 
@@ -2760,29 +2981,29 @@ static void aligned(FICL_VM *pVM)
 **************************************************************************/
 static void beginCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     markBranch(dp, pVM, destTag);
     return;
 }
 
 static void untilCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pIfParen);
+    assert(pVM->pSys->pIfParen);
 
-    dictAppendCell(dp, LVALUEtoCELL(pIfParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pIfParen));
     resolveBackBranch(dp, pVM, destTag);
     return;
 }
 
 static void whileCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pIfParen);
+    assert(pVM->pSys->pIfParen);
 
-    dictAppendCell(dp, LVALUEtoCELL(pIfParen));
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pIfParen));
     markBranch(dp, pVM, origTag);
     twoSwap(pVM);
     dictAppendUNS(dp, 1);
@@ -2791,10 +3012,10 @@ static void whileCoIm(FICL_VM *pVM)
 
 static void repeatCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pBranchParen);
-    dictAppendCell(dp, LVALUEtoCELL(pBranchParen));
+    assert(pVM->pSys->pBranchParen);
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranchParen));
 
     /* expect "begin" branch marker */
     resolveBackBranch(dp, pVM, destTag);
@@ -2806,10 +3027,10 @@ static void repeatCoIm(FICL_VM *pVM)
 
 static void againCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
-    assert(pBranchParen);
-    dictAppendCell(dp, LVALUEtoCELL(pBranchParen));
+    assert(pVM->pSys->pBranchParen);
+    dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranchParen));
 
     /* expect "begin" branch marker */
     resolveBackBranch(dp, pVM, destTag);
@@ -2833,13 +3054,13 @@ static void againCoIm(FICL_VM *pVM)
 **************************************************************************/
 static void ficlChar(FICL_VM *pVM)
 {
-	STRINGINFO si;
+    STRINGINFO si;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,0,1);
+    vmCheckStack(pVM,0,1);
 #endif
 
-	si = vmGetWord(pVM);
-	PUSHUNS((FICL_UNS)(si.cp[0]));
+    si = vmGetWord(pVM);
+    PUSHUNS((FICL_UNS)(si.cp[0]));
     return;
 }
 
@@ -2857,13 +3078,13 @@ static void charCoIm(FICL_VM *pVM)
 **************************************************************************/
 static void charPlus(FICL_VM *pVM)
 {
-	char *cp;
+    char *cp;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,1,1);
+    vmCheckStack(pVM,1,1);
 #endif
 
-	cp = POPPTR();
-	PUSHPTR(cp + 1);
+    cp = POPPTR();
+    PUSHPTR(cp + 1);
     return;
 }
 
@@ -2879,16 +3100,16 @@ static void charPlus(FICL_VM *pVM)
 #endif
 static void ficlChars(FICL_VM *pVM)
 {
-	if (sizeof (char) > 1)
-	{
-		FICL_INT i;
+    if (sizeof (char) > 1)
+    {
+        FICL_INT i;
 #if FICL_ROBUST > 1
-		vmCheckStack(pVM,1,1);
+        vmCheckStack(pVM,1,1);
 #endif
-		i = POPINT();
-		PUSHINT(i * sizeof (char));
-	}
-	/* otherwise no-op! */
+        i = POPINT();
+        PUSHINT(i * sizeof (char));
+    }
+    /* otherwise no-op! */
     return;
 }
 #if defined (_M_IX86)
@@ -2906,14 +3127,14 @@ static void ficlChars(FICL_VM *pVM)
 **************************************************************************/
 static void count(FICL_VM *pVM)
 {
-	FICL_STRING *sp;
+    FICL_STRING *sp;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,1,2);
+    vmCheckStack(pVM,1,2);
 #endif
 
-	sp = POPPTR();
-	PUSHPTR(sp->text);
-	PUSHUNS(sp->count);
+    sp = POPPTR();
+    PUSHPTR(sp->text);
+    PUSHUNS(sp->count);
     return;
 }
 
@@ -2932,32 +3153,28 @@ static void count(FICL_VM *pVM)
 **************************************************************************/
 static void environmentQ(FICL_VM *pVM)
 {
-	FICL_DICT *envp;
-	FICL_COUNT len;
-	char *cp;
-	FICL_WORD *pFW;
-	STRINGINFO si;
+    FICL_DICT *envp;
+    FICL_WORD *pFW;
+    STRINGINFO si;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,1);
+    vmCheckStack(pVM,2,1);
 #endif
 
-	envp = ficlGetEnv();
-	len = (FICL_COUNT)POPUNS();
-	cp = POPPTR();
+    envp = pVM->pSys->envp;
+    si.count = (FICL_COUNT)stackPopUNS(pVM->pStack);
+    si.cp    = stackPopPtr(pVM->pStack);
 
-	IGNORE(len);
-	SI_PSZ(si, cp);
-	pFW = dictLookup(envp, si);
+    pFW = dictLookup(envp, si);
 
-	if (pFW != NULL)
-	{
-		vmExecute(pVM, pFW);
-		PUSHINT(FICL_TRUE);
-	}
-	else
-	{
-		PUSHINT(FICL_FALSE);
-	}
+    if (pFW != NULL)
+    {
+        vmExecute(pVM, pFW);
+        PUSHINT(FICL_TRUE);
+    }
+    else
+    {
+        PUSHINT(FICL_FALSE);
+    }
     return;
 }
 
@@ -2973,24 +3190,24 @@ static void environmentQ(FICL_VM *pVM)
 **************************************************************************/
 static void evaluate(FICL_VM *pVM)
 {
-	FICL_UNS count;
-	char *cp;
-	CELL id;
+    FICL_UNS count;
+    char *cp;
+    CELL id;
     int result;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,0);
+    vmCheckStack(pVM,2,0);
 #endif
 
-	count = POPUNS();
-	cp = POPPTR();
+    count = POPUNS();
+    cp = POPPTR();
 
-	IGNORE(count);
-	id = pVM->sourceID;
-	pVM->sourceID.i = -1;
-	result = ficlExecC(pVM, cp, count);
-	pVM->sourceID = id;
-	if (result != VM_OUTOFTEXT)
-		vmThrow(pVM, result);
+    IGNORE(count);
+    id = pVM->sourceID;
+    pVM->sourceID.i = -1;
+    result = ficlExecC(pVM, cp, count);
+    pVM->sourceID = id;
+    if (result != VM_OUTOFTEXT)
+        vmThrow(pVM, result);
 
     return;
 }
@@ -3006,7 +3223,7 @@ static void evaluate(FICL_VM *pVM)
 **************************************************************************/
 static void stringQuoteIm(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
 
     if (pVM->state == INTERPRET)
     {
@@ -3017,7 +3234,7 @@ static void stringQuoteIm(FICL_VM *pVM)
     }
     else    /* COMPILE state */
     {
-        dictAppendCell(dp, LVALUEtoCELL(pStringLit));
+        dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pStringLit));
         dp->here = PTRtoCELL vmGetString(pVM, (FICL_STRING *)dp->here, '\"');
         dictAlign(dp);
     }
@@ -3043,12 +3260,12 @@ static void type(FICL_VM *pVM)
     */
     if (!pDest)
 	vmThrowErr(pVM, "Error: out of memory");
-
+ 
     strncpy(pDest, cp, count);
     pDest[count] = '\0';
-
+ 
     vmTextOut(pVM, pDest, 0);
-
+ 
     ficlFree(pDest);
     return;
 }
@@ -3069,27 +3286,27 @@ static void type(FICL_VM *pVM)
 **************************************************************************/
 static void ficlWord(FICL_VM *pVM)
 {
-	FICL_STRING *sp;
-	char delim;
-	STRINGINFO   si;
+    FICL_STRING *sp;
+    char delim;
+    STRINGINFO   si;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,1,1);
+    vmCheckStack(pVM,1,1);
 #endif
 
-	sp = (FICL_STRING *)pVM->pad;
-	delim = (char)POPINT();
+    sp = (FICL_STRING *)pVM->pad;
+    delim = (char)POPINT();
     si = vmParseStringEx(pVM, delim, 1);
 
-	if (SI_COUNT(si) > nPAD-1)
-		SI_SETLEN(si, nPAD-1);
+    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));
-	/*#$-GUY CHANGE: I added this.-$#*/
-	sp->text[sp->count] = 0;
-	strcat(sp->text, " ");
+    sp->count = (FICL_COUNT)SI_COUNT(si);
+    strncpy(sp->text, SI_PTR(si), SI_COUNT(si));
+    /*#$-GUY CHANGE: I added this.-$#*/
+    sp->text[sp->count] = 0;
+    strcat(sp->text, " ");
 
-	PUSHPTR(sp);
+    PUSHPTR(sp);
     return;
 }
 
@@ -3103,14 +3320,14 @@ static void ficlWord(FICL_VM *pVM)
 **************************************************************************/
 static void parseNoCopy(FICL_VM *pVM)
 {
-	STRINGINFO si;
+    STRINGINFO si;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,0,2);
+    vmCheckStack(pVM,0,2);
 #endif
 
-	si = vmGetWord0(pVM);
-	PUSHPTR(SI_PTR(si));
-	PUSHUNS(SI_COUNT(si));
+    si = vmGetWord0(pVM);
+    PUSHPTR(SI_PTR(si));
+    PUSHUNS(SI_COUNT(si));
     return;
 }
 
@@ -3126,18 +3343,18 @@ static void parseNoCopy(FICL_VM *pVM)
 **************************************************************************/
 static void parse(FICL_VM *pVM)
 {
-	STRINGINFO si;
-	char delim;
+    STRINGINFO si;
+    char delim;
 
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,1,2);
+    vmCheckStack(pVM,1,2);
 #endif
 
-	delim = (char)POPINT();
+    delim = (char)POPINT();
 
-	si = vmParseStringEx(pVM, delim, 0);
-	PUSHPTR(SI_PTR(si));
-	PUSHUNS(SI_COUNT(si));
+    si = vmParseStringEx(pVM, delim, 0);
+    PUSHPTR(SI_PTR(si));
+    PUSHUNS(SI_COUNT(si));
     return;
 }
 
@@ -3150,21 +3367,21 @@ static void parse(FICL_VM *pVM)
 **************************************************************************/
 static void fill(FICL_VM *pVM)
 {
-	char ch;
-	FICL_UNS u;
-	char *cp;
+    char ch;
+    FICL_UNS u;
+    char *cp;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,3,0);
+    vmCheckStack(pVM,3,0);
 #endif
-	ch = (char)POPINT();
-	u = POPUNS();
-	cp = (char *)POPPTR();
+    ch = (char)POPINT();
+    u = POPUNS();
+    cp = (char *)POPPTR();
 
-	while (u > 0)
-	{
-		*cp++ = ch;
-		u--;
-	}
+    while (u > 0)
+    {
+        *cp++ = ch;
+        u--;
+    }
     return;
 }
 
@@ -3179,29 +3396,68 @@ static void fill(FICL_VM *pVM)
 ** string, the values returned by FIND while compiling may differ from
 ** those returned while not compiling. 
 **************************************************************************/
-static void find(FICL_VM *pVM)
+static void do_find(FICL_VM *pVM, STRINGINFO si, void *returnForFailure)
 {
-	FICL_STRING *sp;
-	FICL_WORD *pFW;
-	STRINGINFO si;
+    FICL_WORD *pFW;
+
+    pFW = dictLookup(vmGetDict(pVM), si);
+    if (pFW)
+    {
+        PUSHPTR(pFW);
+        PUSHINT((wordIsImmediate(pFW) ? 1 : -1));
+    }
+    else
+    {
+        PUSHPTR(returnForFailure);
+        PUSHUNS(0);
+    }
+    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 cFind(FICL_VM *pVM)
+{
+    FICL_STRING *sp;
+    STRINGINFO si;
+
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,1,2);
+    vmCheckStack(pVM,1,2);
 #endif
+    sp = POPPTR();
+    SI_PFS(si, sp);
+    do_find(pVM, si, sp);
+}
 
-	sp = POPPTR();
-	SI_PFS(si, sp);
-	pFW = dictLookup(ficlGetDict(), si);
-	if (pFW)
-	{
-		PUSHPTR(pFW);
-		PUSHINT((wordIsImmediate(pFW) ? 1 : -1));
-	}
-	else
-	{
-		PUSHPTR(sp);
-		PUSHUNS(0);
-	}
-    return;
+
+
+/**************************************************************************
+                        s f i n d
+** FICL   ( c-addr u -- 0 0  |  xt 1  |  xt -1 )
+** Like FIND, but takes "c-addr u" for the string.
+**************************************************************************/
+static void sFind(FICL_VM *pVM)
+{
+    STRINGINFO si;
+
+#if FICL_ROBUST > 1
+    vmCheckStack(pVM,2,2);
+#endif
+
+    si.count = stackPopINT(pVM->pStack);
+    si.cp = stackPopPtr(pVM->pStack);
+
+    do_find(pVM, si, NULL);
 }
 
 
@@ -3216,18 +3472,18 @@ static void find(FICL_VM *pVM)
 **************************************************************************/
 static void fmSlashMod(FICL_VM *pVM)
 {
-	DPINT d1;
-	FICL_INT n1;
-	INTQR qr;
+    DPINT d1;
+    FICL_INT n1;
+    INTQR qr;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,3,2);
+    vmCheckStack(pVM,3,2);
 #endif
 
-	n1 = POPINT();
-	d1 = i64Pop(pVM->pStack);
-	qr = m64FlooredDivI(d1, n1);
-	PUSHINT(qr.rem);
-	PUSHINT(qr.quot);
+    n1 = POPINT();
+    d1 = i64Pop(pVM->pStack);
+    qr = m64FlooredDivI(d1, n1);
+    PUSHINT(qr.rem);
+    PUSHINT(qr.quot);
     return;
 }
 
@@ -3242,36 +3498,36 @@ static void fmSlashMod(FICL_VM *pVM)
 **************************************************************************/
 static void smSlashRem(FICL_VM *pVM)
 {
-	DPINT d1;
-	FICL_INT n1;
-	INTQR qr;
+    DPINT d1;
+    FICL_INT n1;
+    INTQR qr;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,3,2);
+    vmCheckStack(pVM,3,2);
 #endif
 
-	n1 = POPINT();
-	d1 = i64Pop(pVM->pStack);
-	qr = m64SymmetricDivI(d1, n1);
-	PUSHINT(qr.rem);
-	PUSHINT(qr.quot);
+    n1 = POPINT();
+    d1 = i64Pop(pVM->pStack);
+    qr = m64SymmetricDivI(d1, n1);
+    PUSHINT(qr.rem);
+    PUSHINT(qr.quot);
     return;
 }
 
 
 static void ficlMod(FICL_VM *pVM)
 {
-	DPINT d1;
-	FICL_INT n1;
-	INTQR qr;
+    DPINT d1;
+    FICL_INT n1;
+    INTQR qr;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,1);
+    vmCheckStack(pVM,2,1);
 #endif
 
-	n1 = POPINT();
-	d1.lo = POPINT();
-	i64Extend(d1);
-	qr = m64SymmetricDivI(d1, n1);
-	PUSHINT(qr.rem);
+    n1 = POPINT();
+    d1.lo = POPINT();
+    i64Extend(d1);
+    qr = m64SymmetricDivI(d1, n1);
+    PUSHINT(qr.rem);
     return;
 }
 
@@ -3315,31 +3571,31 @@ static void umSlashMod(FICL_VM *pVM)
 **************************************************************************/
 static void lshift(FICL_VM *pVM)
 {
-	FICL_UNS nBits;
-	FICL_UNS x1;
+    FICL_UNS nBits;
+    FICL_UNS x1;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,1);
+    vmCheckStack(pVM,2,1);
 #endif
 
-	nBits = POPUNS();
-	x1 = POPUNS();
-	PUSHUNS(x1 << nBits);
+    nBits = POPUNS();
+    x1 = POPUNS();
+    PUSHUNS(x1 << nBits);
     return;
 }
 
 
 static void rshift(FICL_VM *pVM)
 {
-	FICL_UNS nBits;
-	FICL_UNS x1;
+    FICL_UNS nBits;
+    FICL_UNS x1;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,1);
+    vmCheckStack(pVM,2,1);
 #endif
 
-	nBits = POPUNS();
-	x1 = POPUNS();
+    nBits = POPUNS();
+    x1 = POPUNS();
 
-	PUSHUNS(x1 >> nBits);
+    PUSHUNS(x1 >> nBits);
     return;
 }
 
@@ -3351,36 +3607,36 @@ static void rshift(FICL_VM *pVM)
 **************************************************************************/
 static void mStar(FICL_VM *pVM)
 {
-	FICL_INT n2;
-	FICL_INT n1;
-	DPINT d;
+    FICL_INT n2;
+    FICL_INT n1;
+    DPINT d;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,2);
+    vmCheckStack(pVM,2,2);
 #endif
 
-	n2 = POPINT();
-	n1 = POPINT();
+    n2 = POPINT();
+    n1 = POPINT();
 
-	d = m64MulI(n1, n2);
-	i64Push(pVM->pStack, d);
+    d = m64MulI(n1, n2);
+    i64Push(pVM->pStack, d);
     return;
 }
 
 
 static void umStar(FICL_VM *pVM)
 {
-	FICL_UNS u2;
-	FICL_UNS u1;
-	DPUNS ud;
+    FICL_UNS u2;
+    FICL_UNS u1;
+    DPUNS ud;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,2);
+    vmCheckStack(pVM,2,2);
 #endif
 
-	u2 = POPUNS();
-	u1 = POPUNS();
+    u2 = POPUNS();
+    u1 = POPUNS();
 
-	ud = ficlLongMul(u1, u2);
-	u64Push(pVM->pStack, ud);
+    ud = ficlLongMul(u1, u2);
+    u64Push(pVM->pStack, ud);
     return;
 }
 
@@ -3391,31 +3647,31 @@ static void umStar(FICL_VM *pVM)
 **************************************************************************/
 static void ficlMax(FICL_VM *pVM)
 {
-	FICL_INT n2;
-	FICL_INT n1;
+    FICL_INT n2;
+    FICL_INT n1;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,1);
+    vmCheckStack(pVM,2,1);
 #endif
 
-	n2 = POPINT();
-	n1 = POPINT();
+    n2 = POPINT();
+    n1 = POPINT();
 
-	PUSHINT((n1 > n2) ? n1 : n2);
+    PUSHINT((n1 > n2) ? n1 : n2);
     return;
 }
 
 static void ficlMin(FICL_VM *pVM)
 {
-	FICL_INT n2;
-	FICL_INT n1;
+    FICL_INT n2;
+    FICL_INT n1;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,1);
+    vmCheckStack(pVM,2,1);
 #endif
 
-	n2 = POPINT();
-	n1 = POPINT();
+    n2 = POPINT();
+    n1 = POPINT();
 
-	PUSHINT((n1 < n2) ? n1 : n2);
+    PUSHINT((n1 < n2) ? n1 : n2);
     return;
 }
 
@@ -3432,16 +3688,16 @@ static void ficlMin(FICL_VM *pVM)
 **************************************************************************/
 static void move(FICL_VM *pVM)
 {
-	FICL_UNS u;
-	char *addr2;
-	char *addr1;
+    FICL_UNS u;
+    char *addr2;
+    char *addr1;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,3,0);
+    vmCheckStack(pVM,3,0);
 #endif
 
-	u = POPUNS();
-	addr2 = POPPTR();
-	addr1 = POPPTR();
+    u = POPUNS();
+    addr2 = POPPTR();
+    addr1 = POPPTR();
 
     if (u == 0) 
         return;
@@ -3472,7 +3728,7 @@ static void move(FICL_VM *pVM)
 **************************************************************************/
 static void recurseCoIm(FICL_VM *pVM)
 {
-    FICL_DICT *pDict = ficlGetDict();
+    FICL_DICT *pDict = vmGetDict(pVM);
 
     IGNORE(pVM);
     dictAppendCell(pDict, LVALUEtoCELL(pDict->smudge));
@@ -3488,16 +3744,16 @@ static void recurseCoIm(FICL_VM *pVM)
 **************************************************************************/
 static void sToD(FICL_VM *pVM)
 {
-	FICL_INT s;
+    FICL_INT s;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,1,2);
+    vmCheckStack(pVM,1,2);
 #endif
 
-	s = POPINT();
+    s = POPINT();
 
-	/* sign extend to 64 bits.. */
-	PUSHINT(s);
-	PUSHINT((s < 0) ? -1 : 0);
+    /* sign extend to 64 bits.. */
+    PUSHINT(s);
+    PUSHINT((s < 0) ? -1 : 0);
     return;
 }
 
@@ -3511,9 +3767,9 @@ static void sToD(FICL_VM *pVM)
 static void source(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,0,2);
+    vmCheckStack(pVM,0,2);
 #endif
-	PUSHPTR(pVM->tib.cp);
+    PUSHPTR(pVM->tib.cp);
     PUSHINT(vmGetInBufLen(pVM));
     return;
 }
@@ -3537,9 +3793,9 @@ static void ficlVersion(FICL_VM *pVM)
 static void toIn(FICL_VM *pVM)
 {
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,0,1);
+    vmCheckStack(pVM,0,1);
 #endif
-	PUSHPTR(&pVM->tib.index);
+    PUSHPTR(&pVM->tib.index);
     return;
 }
 
@@ -3552,7 +3808,7 @@ static void toIn(FICL_VM *pVM)
 **************************************************************************/
 static void colonNoName(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     FICL_WORD *pFW;
     STRINGINFO si;
 
@@ -3594,7 +3850,7 @@ static void userParen(FICL_VM *pVM)
 
 static void userVariable(FICL_VM *pVM)
 {
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     STRINGINFO si = vmGetWord(pVM);
     CELL c;
 
@@ -3622,30 +3878,30 @@ static void userVariable(FICL_VM *pVM)
 static void toValue(FICL_VM *pVM)
 {
     STRINGINFO si = vmGetWord(pVM);
-    FICL_DICT *dp = ficlGetDict();
+    FICL_DICT *dp = vmGetDict(pVM);
     FICL_WORD *pFW;
 
 #if FICL_WANT_LOCALS
-    if ((nLocals > 0) && (pVM->state == COMPILE))
+    if ((pVM->pSys->nLocals > 0) && (pVM->state == COMPILE))
     {
-        FICL_DICT *pLoc = ficlGetLoc();
+        FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
         pFW = dictLookup(pLoc, si);
         if (pFW && (pFW->code == doLocalIm))
         {
-            dictAppendCell(dp, LVALUEtoCELL(pToLocalParen));
+            dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pToLocalParen));
             dictAppendCell(dp, LVALUEtoCELL(pFW->param[0]));
             return;
         }
         else if (pFW && pFW->code == do2LocalIm)
         {
-            dictAppendCell(dp, LVALUEtoCELL(pTo2LocalParen));
+            dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pTo2LocalParen));
             dictAppendCell(dp, LVALUEtoCELL(pFW->param[0]));
             return;
         }
     }
 #endif
 
-    assert(pStore);
+    assert(pVM->pSys->pStore);
 
     pFW = dictLookup(dp, si);
     if (!pFW)
@@ -3660,7 +3916,7 @@ static void toValue(FICL_VM *pVM)
     {
         PUSHPTR(&pFW->param[0]);
         literalIm(pVM);
-        dictAppendCell(dp, LVALUEtoCELL(pStore));
+        dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pStore));
     }
     return;
 }
@@ -3750,8 +4006,8 @@ static void toLocal1(FICL_VM *pVM)
 */
 static void doLocalIm(FICL_VM *pVM)
 {
-    FICL_DICT *pDict = ficlGetDict();
-    int nLocal = pVM->runningWord->param[0].i;
+    FICL_DICT *pDict = vmGetDict(pVM);
+    FICL_INT nLocal = pVM->runningWord->param[0].i;
 
     if (pVM->state == INTERPRET)
     {
@@ -3762,15 +4018,15 @@ static void doLocalIm(FICL_VM *pVM)
         
         if (nLocal == 0)
         {
-            dictAppendCell(pDict, LVALUEtoCELL(pGetLocal0));
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pGetLocal0));
         }
         else if (nLocal == 1)
         {
-            dictAppendCell(pDict, LVALUEtoCELL(pGetLocal1));
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pGetLocal1));
         }
         else
         {
-            dictAppendCell(pDict, LVALUEtoCELL(pGetLocalParen));
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pGetLocalParen));
             dictAppendCell(pDict, LVALUEtoCELL(nLocal));
         }
     }
@@ -3803,52 +4059,51 @@ static void doLocalIm(FICL_VM *pVM)
 **************************************************************************/
 static void localParen(FICL_VM *pVM)
 {
-	static CELL *pMark = NULL;
-	FICL_DICT *pDict;
-	STRINGINFO si;
+    FICL_DICT *pDict;
+    STRINGINFO si;
 #if FICL_ROBUST > 1
-	vmCheckStack(pVM,2,0);  
+    vmCheckStack(pVM,2,0);  
 #endif
 
-	pDict = ficlGetDict();
-	SI_SETLEN(si, POPUNS());
-	SI_SETPTR(si, (char *)POPPTR());
+    pDict = vmGetDict(pVM);
+    SI_SETLEN(si, POPUNS());
+    SI_SETPTR(si, (char *)POPPTR());
 
     if (SI_COUNT(si) > 0)
     {   /* add a local to the **locals** dict and update nLocals */
-        FICL_DICT *pLoc = ficlGetLoc();
-        if (nLocals >= FICL_MAX_LOCALS)
+        FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
+        if (pVM->pSys->nLocals >= FICL_MAX_LOCALS)
         {
             vmThrowErr(pVM, "Error: out of local space");
         }
 
         dictAppendWord2(pLoc, si, doLocalIm, FW_COMPIMMED);
-        dictAppendCell(pLoc,  LVALUEtoCELL(nLocals));
+        dictAppendCell(pLoc,  LVALUEtoCELL(pVM->pSys->nLocals));
 
-        if (nLocals == 0)
+        if (pVM->pSys->nLocals == 0)
         {   /* compile code to create a local stack frame */
-            dictAppendCell(pDict, LVALUEtoCELL(pLinkParen));
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pLinkParen));
             /* save location in dictionary for #locals */
-            pMarkLocals = pDict->here;
-            dictAppendCell(pDict, LVALUEtoCELL(nLocals));
+            pVM->pSys->pMarkLocals = pDict->here;
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->nLocals));
             /* compile code to initialize first local */
-            dictAppendCell(pDict, LVALUEtoCELL(pToLocal0));
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pToLocal0));
         }
-        else if (nLocals == 1)
+        else if (pVM->pSys->nLocals == 1)
         {
-            dictAppendCell(pDict, LVALUEtoCELL(pToLocal1));
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pToLocal1));
         }
         else
         {
-            dictAppendCell(pDict, LVALUEtoCELL(pToLocalParen));
-            dictAppendCell(pDict, LVALUEtoCELL(nLocals));
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pToLocalParen));
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->nLocals));
         }
 
-        nLocals++;
+        (pVM->pSys->nLocals)++;
     }
-    else if (nLocals > 0)
+    else if (pVM->pSys->nLocals > 0)
     {       /* write nLocals to (link) param area in dictionary */
-        *(FICL_INT *)pMarkLocals = nLocals;
+        *(FICL_INT *)(pVM->pSys->pMarkLocals) = pVM->pSys->nLocals;
     }
 
     return;
@@ -3866,8 +4121,8 @@ static void get2LocalParen(FICL_VM *pVM)
 
 static void do2LocalIm(FICL_VM *pVM)
 {
-    FICL_DICT *pDict = ficlGetDict();
-    int nLocal = pVM->runningWord->param[0].i;
+    FICL_DICT *pDict = vmGetDict(pVM);
+    FICL_INT nLocal = pVM->runningWord->param[0].i;
 
     if (pVM->state == INTERPRET)
     {
@@ -3876,7 +4131,7 @@ static void do2LocalIm(FICL_VM *pVM)
     }
     else
     {
-        dictAppendCell(pDict, LVALUEtoCELL(pGet2LocalParen));
+        dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pGet2LocalParen));
         dictAppendCell(pDict, LVALUEtoCELL(nLocal));
     }
     return;
@@ -3894,38 +4149,38 @@ static void to2LocalParen(FICL_VM *pVM)
 
 static void twoLocalParen(FICL_VM *pVM)
 {
-    FICL_DICT *pDict = ficlGetDict();
+    FICL_DICT *pDict = vmGetDict(pVM);
     STRINGINFO si;
     SI_SETLEN(si, stackPopUNS(pVM->pStack));
     SI_SETPTR(si, (char *)stackPopPtr(pVM->pStack));
 
     if (SI_COUNT(si) > 0)
     {   /* add a local to the **locals** dict and update nLocals */
-        FICL_DICT *pLoc = ficlGetLoc();
-        if (nLocals >= FICL_MAX_LOCALS)
+        FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
+        if (pVM->pSys->nLocals >= FICL_MAX_LOCALS)
         {
             vmThrowErr(pVM, "Error: out of local space");
         }
 
         dictAppendWord2(pLoc, si, do2LocalIm, FW_COMPIMMED);
-        dictAppendCell(pLoc,  LVALUEtoCELL(nLocals));
+        dictAppendCell(pLoc,  LVALUEtoCELL(pVM->pSys->nLocals));
 
-        if (nLocals == 0)
+        if (pVM->pSys->nLocals == 0)
         {   /* compile code to create a local stack frame */
-            dictAppendCell(pDict, LVALUEtoCELL(pLinkParen));
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pLinkParen));
             /* save location in dictionary for #locals */
-            pMarkLocals = pDict->here;
-            dictAppendCell(pDict, LVALUEtoCELL(nLocals));
+            pVM->pSys->pMarkLocals = pDict->here;
+            dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->nLocals));
         }
 
-        dictAppendCell(pDict, LVALUEtoCELL(pTo2LocalParen));
-        dictAppendCell(pDict, LVALUEtoCELL(nLocals));
+        dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->pTo2LocalParen));
+        dictAppendCell(pDict, LVALUEtoCELL(pVM->pSys->nLocals));
 
-        nLocals += 2;
+        pVM->pSys->nLocals += 2;
     }
-    else if (nLocals > 0)
+    else if (pVM->pSys->nLocals > 0)
     {       /* write nLocals to (link) param area in dictionary */
-        *(FICL_INT *)pMarkLocals = nLocals;
+        *(FICL_INT *)(pVM->pSys->pMarkLocals) = pVM->pSys->nLocals;
     }
 
     return;
@@ -3947,7 +4202,7 @@ static void twoLocalParen(FICL_VM *pVM)
 ** 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)
+static void compareInternal(FICL_VM *pVM, int caseInsensitive)
 {
     char *cp1, *cp2;
     FICL_UNS u1, u2, uMin;
@@ -3962,7 +4217,14 @@ static void compareString(FICL_VM *pVM)
     uMin = (u1 < u2)? u1 : u2;
     for ( ; (uMin > 0) && (n == 0); uMin--)
     {
-        n = (int)(*cp1++ - *cp2++);
+		char c1 = *cp1++;
+		char c2 = *cp2++;
+		if (caseInsensitive)
+		{
+			c1 = (char)tolower(c1);
+			c2 = (char)tolower(c2);
+		}
+        n = (int)(c1 - c2);
     }
 
     if (n == 0)
@@ -3978,6 +4240,30 @@ static void compareString(FICL_VM *pVM)
 }
 
 
+static void compareString(FICL_VM *pVM)
+{
+	compareInternal(pVM, FALSE);
+}
+
+
+static void compareStringInsensitive(FICL_VM *pVM)
+{
+	compareInternal(pVM, TRUE);
+}
+
+
+/**************************************************************************
+                        p a d
+** CORE EXT  ( -- c-addr )
+** c-addr is the address of a transient region that can be used to hold
+** data for intermediate processing.
+**************************************************************************/
+static void pad(FICL_VM *pVM)
+{
+    stackPushPtr(pVM->pStack, pVM->pad);
+}
+
+
 /**************************************************************************
                         s o u r c e - i d
 ** CORE EXT, FILE   ( -- 0 | -1 | fileid )
@@ -4043,8 +4329,6 @@ static void refill(FICL_VM *pVM)
 
 static void ficlCatch(FICL_VM *pVM)
 {
-    static FICL_WORD *pQuit = NULL;
-
     int         except;
     jmp_buf     vmState;
     FICL_VM     VM;
@@ -4052,11 +4336,8 @@ static void ficlCatch(FICL_VM *pVM)
     FICL_STACK  rStack;
     FICL_WORD   *pFW;
 
-    if (!pQuit)
-        pQuit = ficlLookup("exit-inner");
-
     assert(pVM);
-    assert(pQuit);
+    assert(pVM->pSys->pExitInner);
     
 
     /*
@@ -4103,7 +4384,7 @@ static void ficlCatch(FICL_VM *pVM)
         ** the XT
         */
     case 0:
-        vmPushIP(pVM, &pQuit);          /* Open mouth, insert emetic */
+        vmPushIP(pVM, &(pVM->pSys->pExitInner));          /* Open mouth, insert emetic */
         vmExecute(pVM, pFW);
         vmInnerLoop(pVM);
         break;
@@ -4267,19 +4548,22 @@ WORDKIND ficlWordClassify(FICL_WORD *pFW)
 
     static CODEtoKIND codeMap[] =
     {
-        {BRANCH, branchParen},
-        {COLON, colonParen},
+        {BRANCH,     branchParen},
+        {COLON,       colonParen},
         {CONSTANT, constantParen},
-        {CREATE, createParen},
-        {DO, doParen},
-        {DOES, doDoes},
-        {IF, ifParen},
-        {LITERAL, literalParen},
-        {LOOP, loopParen},
-        {PLOOP, plusLoopParen},
-        {QDO, qDoParen},
-        {STRINGLIT, stringLit},
-        {USER, userParen},
+        {CREATE,     createParen},
+        {DO,             doParen},
+        {DOES,            doDoes},
+        {IF,             ifParen},
+        {LITERAL,   literalParen},
+        {LOOP,         loopParen},
+        {PLOOP,    plusLoopParen},
+        {QDO,           qDoParen},
+        {CSTRINGLIT,  cstringLit},
+        {STRINGLIT,    stringLit},
+#if FICL_WANT_USER
+        {USER,         userParen},
+#endif
         {VARIABLE, variableParen},
     };
 
@@ -4308,11 +4592,12 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     FICL_DICT *dp = pSys->dp;
     assert (dp);
 
+
     /*
     ** CORE word set
     ** see softcore.c for definitions of: abs bl space spaces abort"
     */
-    pStore =
+    pSys->pStore =
     dictAppendWord(dp, "!",         store,          FW_DEFAULT);
     dictAppendWord(dp, "#",         numberSign,     FW_DEFAULT);
     dictAppendWord(dp, "#>",        numberSignGreater,FW_DEFAULT);
@@ -4325,7 +4610,6 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     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);
@@ -4334,7 +4618,6 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     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);
@@ -4390,10 +4673,9 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     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, "find",      cFind,          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);
@@ -4429,7 +4711,6 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     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);
@@ -4447,17 +4728,25 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     dictAppendWord(dp, "]",         rbracket,       FW_DEFAULT);
     /* 
     ** CORE EXT word set...
-    ** see softcore.c for other definitions
+    ** see softcore.fr for other definitions
     */
-    dictAppendWord(dp, ".(",        dotParen,       FW_DEFAULT);
-    dictAppendWord(dp, ":noname",   colonNoName,    FW_DEFAULT);
+    /* "#tib" */
+    dictAppendWord(dp, ".(",        dotParen,       FW_IMMEDIATE);
+    /* ".r" */
+    dictAppendWord(dp, "0>",        zeroGreater,    FW_DEFAULT);
     dictAppendWord(dp, "2>r",       twoToR,         FW_COMPILE);
     dictAppendWord(dp, "2r>",       twoRFrom,       FW_COMPILE);
     dictAppendWord(dp, "2r@",       twoRFetch,      FW_COMPILE);
+    dictAppendWord(dp, ":noname",   colonNoName,    FW_DEFAULT);
     dictAppendWord(dp, "?do",       qDoCoIm,        FW_COMPIMMED);
     dictAppendWord(dp, "again",     againCoIm,      FW_COMPIMMED);
+    dictAppendWord(dp, "c\"",       cstringQuoteIm, FW_IMMEDIATE);
+    /* case of endof endcase */
+    dictAppendWord(dp, "hex",       hex,            FW_DEFAULT);
+    dictAppendWord(dp, "pad",       pad,            FW_DEFAULT);
     dictAppendWord(dp, "parse",     parse,          FW_DEFAULT);
     dictAppendWord(dp, "pick",      pick,           FW_DEFAULT);
+    /* query restore-input save-input tib u.r u> unused [compile] */
     dictAppendWord(dp, "roll",      roll,           FW_DEFAULT);
     dictAppendWord(dp, "refill",    refill,         FW_DEFAULT);
     dictAppendWord(dp, "source-id", sourceid,       FW_DEFAULT);
@@ -4469,20 +4758,20 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     /*
     ** 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);
+    ficlSetEnv(pSys, "/counted-string",   FICL_STRING_MAX);
+    ficlSetEnv(pSys, "/hold",             nPAD);
+    ficlSetEnv(pSys, "/pad",              nPAD);
+    ficlSetEnv(pSys, "address-unit-bits", 8);
+    ficlSetEnv(pSys, "core",              FICL_TRUE);
+    ficlSetEnv(pSys, "core-ext",          FICL_FALSE);
+    ficlSetEnv(pSys, "floored",           FICL_FALSE);
+    ficlSetEnv(pSys, "max-char",          UCHAR_MAX);
+    ficlSetEnvD(pSys,"max-d",             0x7fffffff, 0xffffffff);
+    ficlSetEnv(pSys, "max-n",             0x7fffffff);
+    ficlSetEnv(pSys, "max-u",             0xffffffff);
+    ficlSetEnvD(pSys,"max-ud",            0xffffffff, 0xffffffff);
+    ficlSetEnv(pSys, "return-stack-cells",FICL_DEFAULT_STACK);
+    ficlSetEnv(pSys, "stack-cells",       FICL_DEFAULT_STACK);
 
     /*
     ** DOUBLE word set (partial)
@@ -4499,42 +4788,42 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     dictAppendWord(dp, "catch",     ficlCatch,      FW_DEFAULT);
     dictAppendWord(dp, "throw",     ficlThrow,      FW_DEFAULT);
 
-    ficlSetEnv("exception",         FICL_TRUE);
-    ficlSetEnv("exception-ext",     FICL_TRUE);
+    ficlSetEnv(pSys, "exception",         FICL_TRUE);
+    ficlSetEnv(pSys, "exception-ext",     FICL_TRUE);
 
     /*
     ** LOCAL and LOCAL EXT
     ** see softcore.c for implementation of locals|
     */
 #if FICL_WANT_LOCALS
-    pLinkParen = 
+    pSys->pLinkParen = 
     dictAppendWord(dp, "(link)",    linkParen,      FW_COMPILE);
-    pUnLinkParen = 
+    pSys->pUnLinkParen = 
     dictAppendWord(dp, "(unlink)",  unlinkParen,    FW_COMPILE);
     dictAppendWord(dp, "doLocal",   doLocalIm,      FW_COMPIMMED);
-    pGetLocalParen =
+    pSys->pGetLocalParen =
     dictAppendWord(dp, "(@local)",  getLocalParen,  FW_COMPILE);
-    pToLocalParen =
+    pSys->pToLocalParen =
     dictAppendWord(dp, "(toLocal)", toLocalParen,   FW_COMPILE);
-    pGetLocal0 =
+    pSys->pGetLocal0 =
     dictAppendWord(dp, "(@local0)", getLocal0,      FW_COMPILE);
-    pToLocal0 =
+    pSys->pToLocal0 =
     dictAppendWord(dp, "(toLocal0)",toLocal0,       FW_COMPILE);
-    pGetLocal1 =
+    pSys->pGetLocal1 =
     dictAppendWord(dp, "(@local1)", getLocal1,      FW_COMPILE);
-    pToLocal1 =
+    pSys->pToLocal1 =
     dictAppendWord(dp, "(toLocal1)",toLocal1,       FW_COMPILE);
     dictAppendWord(dp, "(local)",   localParen,     FW_COMPILE);
 
-    pGet2LocalParen =
+    pSys->pGet2LocalParen =
     dictAppendWord(dp, "(@2local)", get2LocalParen, FW_COMPILE);
-    pTo2LocalParen =
+    pSys->pTo2LocalParen =
     dictAppendWord(dp, "(to2Local)",to2LocalParen,  FW_COMPILE);
     dictAppendWord(dp, "(2local)",  twoLocalParen,  FW_COMPILE);
 
-    ficlSetEnv("locals",            FICL_TRUE);
-    ficlSetEnv("locals-ext",        FICL_TRUE);
-    ficlSetEnv("#locals",           FICL_MAX_LOCALS);
+    ficlSetEnv(pSys, "locals",            FICL_TRUE);
+    ficlSetEnv(pSys, "locals-ext",        FICL_TRUE);
+    ficlSetEnv(pSys, "#locals",           FICL_MAX_LOCALS);
 #endif
 
     /*
@@ -4545,8 +4834,7 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     dictAppendWord(dp, "free",      ansFree,        FW_DEFAULT);
     dictAppendWord(dp, "resize",    ansResize,      FW_DEFAULT);
     
-    ficlSetEnv("memory-alloc",      FICL_TRUE);
-    ficlSetEnv("memory-alloc-ext",  FICL_FALSE);
+    ficlSetEnv(pSys, "memory-alloc",      FICL_TRUE);
 
     /*
     ** optional SEARCH-ORDER word set 
@@ -4559,8 +4847,18 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     ficlCompileTools(pSys);
 
     /*
+    ** FILE and FILE EXT
+    */
+#if FICL_WANT_FILE
+    ficlCompileFile(pSys);
+#endif
+
+    /*
     ** Ficl extras
     */
+#if FICL_WANT_FLOAT
+    dictAppendWord(dp, ".hash",     dictHashSummary,FW_DEFAULT);
+#endif
     dictAppendWord(dp, ".ver",      ficlVersion,    FW_DEFAULT);
     dictAppendWord(dp, "-roll",     minusRoll,      FW_DEFAULT);
     dictAppendWord(dp, ">name",     toName,         FW_DEFAULT);
@@ -4568,13 +4866,19 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
                                     addParseStep,   FW_DEFAULT);
     dictAppendWord(dp, "body>",     fromBody,       FW_DEFAULT);
     dictAppendWord(dp, "compare",   compareString,  FW_DEFAULT);   /* STRING */
+    dictAppendWord(dp, "compare-insensitive",   compareStringInsensitive,  FW_DEFAULT);   /* STRING */
     dictAppendWord(dp, "compile-only",
                                     compileOnly,    FW_DEFAULT);
     dictAppendWord(dp, "endif",     endifCoIm,      FW_COMPIMMED);
     dictAppendWord(dp, "last-word", getLastWord,    FW_DEFAULT);
     dictAppendWord(dp, "hash",      hash,           FW_DEFAULT);
+    dictAppendWord(dp, "objectify", setObjectFlag,  FW_DEFAULT);
+    dictAppendWord(dp, "?object",   isObject,       FW_DEFAULT);
     dictAppendWord(dp, "parse-word",parseNoCopy,    FW_DEFAULT);
+    dictAppendWord(dp, "sfind",     sFind,          FW_DEFAULT);
     dictAppendWord(dp, "sliteral",  sLiteralCoIm,   FW_COMPIMMED); /* STRING */
+    dictAppendWord(dp, "sprintf",   ficlSprintf,    FW_DEFAULT);
+    dictAppendWord(dp, "strlen",    ficlStrlen,     FW_DEFAULT);
     dictAppendWord(dp, "q@",        quadFetch,      FW_DEFAULT);
     dictAppendWord(dp, "q!",        quadStore,      FW_DEFAULT);
     dictAppendWord(dp, "w@",        wFetch,         FW_DEFAULT);
@@ -4584,42 +4888,54 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
     dictAppendWord(dp, "(user)",    userParen,      FW_DEFAULT);
     dictAppendWord(dp, "user",      userVariable,   FW_DEFAULT);
 #endif
+
     /*
     ** internal support words
     */
     dictAppendWord(dp, "(create)",  createParen,    FW_COMPILE);
-    pExitParen =
+    pSys->pExitParen =
     dictAppendWord(dp, "(exit)",    exitParen,      FW_COMPILE);
-    pSemiParen =
+    pSys->pSemiParen =
     dictAppendWord(dp, "(;)",       semiParen,      FW_COMPILE);
-    pLitParen = 
+    pSys->pLitParen = 
     dictAppendWord(dp, "(literal)", literalParen,   FW_COMPILE);
-    pTwoLitParen = 
+    pSys->pTwoLitParen = 
     dictAppendWord(dp, "(2literal)",twoLitParen,    FW_COMPILE);
-    pStringLit =
+    pSys->pStringLit =
     dictAppendWord(dp, "(.\")",     stringLit,      FW_COMPILE);
-    pIfParen =
+    pSys->pCStringLit =
+    dictAppendWord(dp, "(c\")",     cstringLit,     FW_COMPILE);
+    pSys->pIfParen =
     dictAppendWord(dp, "(if)",      ifParen,        FW_COMPILE);
-    pBranchParen =
+    pSys->pBranchParen =
     dictAppendWord(dp, "(branch)",  branchParen,    FW_COMPILE);
-    pDoParen =
+    pSys->pDoParen =
     dictAppendWord(dp, "(do)",      doParen,        FW_COMPILE);
-    pDoesParen =
+    pSys->pDoesParen =
     dictAppendWord(dp, "(does>)",   doesParen,      FW_COMPILE);
-    pQDoParen =
+    pSys->pQDoParen =
     dictAppendWord(dp, "(?do)",     qDoParen,       FW_COMPILE);
-    pLoopParen =
+    pSys->pLoopParen =
     dictAppendWord(dp, "(loop)",    loopParen,      FW_COMPILE);
-    pPLoopParen =
+    pSys->pPLoopParen =
     dictAppendWord(dp, "(+loop)",   plusLoopParen,  FW_COMPILE);
-    pInterpret =
+    pSys->pInterpret =
     dictAppendWord(dp, "interpret", interpret,      FW_DEFAULT);
+    dictAppendWord(dp, "lookup",    lookup,         FW_DEFAULT);
     dictAppendWord(dp, "(variable)",variableParen,  FW_COMPILE);
     dictAppendWord(dp, "(constant)",constantParen,  FW_COMPILE);
     dictAppendWord(dp, "(parse-step)", 
                                     parseStepParen, FW_DEFAULT);
+	pSys->pExitInner =
     dictAppendWord(dp, "exit-inner",ficlExitInner,  FW_DEFAULT);
 
+    /*
+    ** Set up system's outer interpreter loop - maybe this should be in initSystem?
+    */
+	pSys->pInterp[0] = pSys->pInterpret;
+	pSys->pInterp[1] = pSys->pBranchParen;
+	pSys->pInterp[2] = (FICL_WORD *)(void *)(-2);
+
     assert(dictCellsAvail(dp) > 0);
 
     return;