6185 want ficl scripting engine in illumos (loader project)

Reviewed by: Richard Lowe <richlowe@richlowe.net>
Reviewed by: Andrew Stormont <andyjstormont@gmail.com>
Approved by: Robert Mustacchi <rm@joyent.com>

77 files changed, 22698 insertions, 0 deletions

diff --git a/exception_lists/copyright b/exception_lists/copyright
index 0358e5aaf6..cfa21a1520 100644
--- a/exception_lists/copyright
+++ b/exception_lists/copyright
@@ -72,6 +72,7 @@ usr/src/common/bzip2/bzlib.c
 usr/src/common/bzip2/decompress.c
 usr/src/common/bzip2/bzlib_private.h
 usr/src/common/bzip2/huffman.c
+usr/src/common/ficl/*
 usr/src/grub/grub-0.97/stage2/Makefile.am
 usr/src/grub/grub-0.97/stage2/builtins.c
 usr/src/grub/grub-0.97/stage2/disk_io.c
diff --git a/exception_lists/cstyle b/exception_lists/cstyle
index 1705474800..fbcb984f9d 100644
--- a/exception_lists/cstyle
+++ b/exception_lists/cstyle
@@ -146,6 +146,7 @@ usr/src/cmd/mandoc/term_ps.c
 usr/src/cmd/mandoc/term.c
 usr/src/cmd/mandoc/term.h
 usr/src/cmd/mandoc/tree.c
+usr/src/common/ficl/ficltokens.h
 usr/src/common/bzip2/bzlib.h
 usr/src/common/bzip2/crctable.c
 usr/src/common/bzip2/randtable.c
diff --git a/exception_lists/hdrchk b/exception_lists/hdrchk
index c6fc1818f7..3fc275f6af 100644
--- a/exception_lists/hdrchk
+++ b/exception_lists/hdrchk
@@ -51,6 +51,7 @@ usr/src/cmd/mandoc/roff_int.h
 usr/src/cmd/mandoc/roff.h
 usr/src/cmd/mandoc/tag.h
 usr/src/cmd/mandoc/term.h
+usr/src/common/ficl/ficltokens.h
 usr/src/grub/grub-0.97/stage2/shared.h
 usr/src/lib/gss_mechs/mech_krb5/et/error_table.h
 usr/src/lib/gss_mechs/mech_krb5/et/internal.h
diff --git a/exception_lists/packaging b/exception_lists/packaging
index d3619714ec..b406d8e42f 100644
--- a/exception_lists/packaging
+++ b/exception_lists/packaging
@@ -24,6 +24,7 @@
 # Copyright 2012 OmniTI Computer Consulting, Inc.  All rights reserved.
 # Copyright 2014 Garrett D'Amore <garrett@damore.org>
 # Copyright 2014 Nexenta Systems, Inc.  All rights reserved.
+# Copyright 2016 Toomas Soome <tsoome@me.com>
 #
 
 #
@@ -984,3 +985,14 @@ usr/lib/llib-lpcidb.ln
 # debugging program for libadutils
 #
 usr/bin/test-getdc
+#
+# libficl-sys is private
+#
+usr/include/ficllocal.h
+usr/lib/amd64/llib-lficl-sys.ln		i386
+usr/lib/amd64/libficl-sys.so		i386
+usr/lib/sparcv9/llib-lficl-sys.ln	sparc
+usr/lib/sparcv9/libficl-sys.so		sparc
+usr/lib/llib-lficl-sys
+usr/lib/llib-lficl-sys.ln
+usr/lib/libficl-sys.so
diff --git a/usr/src/cmd/Makefile b/usr/src/cmd/Makefile
index c9a38ebfe8..f26f4d684f 100644
--- a/usr/src/cmd/Makefile
+++ b/usr/src/cmd/Makefile
@@ -25,6 +25,7 @@
 # Copyright (c) 2012 by Delphix. All rights reserved.
 # Copyright (c) 2013 DEY Storage Systems, Inc. All rights reserved.
 # Copyright 2014 Garrett D'Amore <garrett@damore.org>
+# Copyright 2016 Toomas Soome <tsoome@me.com>
 
 include ../Makefile.master
 
@@ -153,6 +154,7 @@ COMMON_SUBDIRS=		\
 	fdetach		\
 	fdformat	\
 	fdisk		\
+	ficl		\
 	filesync	\
 	fgrep		\
 	file		\
diff --git a/usr/src/cmd/ficl/Makefile b/usr/src/cmd/ficl/Makefile
new file mode 100644
index 0000000000..6e2c325821
--- /dev/null
+++ b/usr/src/cmd/ficl/Makefile
@@ -0,0 +1,45 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+# cmd/ficl/Makefile
+#
+
+PROG=	ficl-sys
+
+include ../Makefile.cmd
+
+SUBDIRS=	$(MACH)
+$(BUILD64)SUBDIRS += $(MACH64)
+
+all	:=	TARGET = all
+install	:=	TARGET = install
+clean	:=	TARGET = clean
+clobber	:=	TARGET = clobber
+
+.KEEP_STATE:
+
+all:	$(SUBDIRS)
+
+clean clobber lint:	$(SUBDIRS)
+
+install:	$(SUBDIRS)
+	-$(RM) $(ROOTPROG)
+	-$(LN) $(ISAEXEC) $(ROOTPROG)
+
+$(SUBDIRS):	FRC
+	@cd $@; pwd; $(MAKE) $(TARGET)
+
+FRC:
+
+include ../Makefile.targ
diff --git a/usr/src/cmd/ficl/Makefile.com b/usr/src/cmd/ficl/Makefile.com
new file mode 100644
index 0000000000..6be92a0115
--- /dev/null
+++ b/usr/src/cmd/ficl/Makefile.com
@@ -0,0 +1,41 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+PROG= ficl-sys
+OBJS= main.o
+SRCS= main.c
+
+include ../../Makefile.cmd
+include ../../Makefile.ctf
+
+LDLIBS += -lficl-sys -ltecla -lumem
+CPPFLAGS += -D_FILE_OFFSET_BITS=64 -I$(SRC)/common/ficl
+
+.KEEP_STATE:
+
+all: $(PROG)
+
+$(PROG): $(OBJS)
+	$(LINK.c) $(OBJS) -o $@ $(LDLIBS)
+	$(POST_PROCESS)
+
+clean:
+	$(RM) $(OBJS)
+
+include ../../Makefile.targ
+
+%.o:	$(SRC)/common/ficl/%.c
+	$(COMPILE.c) $(OUTPUT_OPTION) $< $(CTFCONVERT_HOOK)
+	$(POST_PROCESS_O)
diff --git a/usr/src/cmd/ficl/amd64/Makefile b/usr/src/cmd/ficl/amd64/Makefile
new file mode 100644
index 0000000000..5947231d79
--- /dev/null
+++ b/usr/src/cmd/ficl/amd64/Makefile
@@ -0,0 +1,19 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include ../Makefile.com
+include ../../Makefile.cmd.64
+
+install: all $(ROOTPROG64)
diff --git a/usr/src/cmd/ficl/i386/Makefile b/usr/src/cmd/ficl/i386/Makefile
new file mode 100644
index 0000000000..df3cfceab6
--- /dev/null
+++ b/usr/src/cmd/ficl/i386/Makefile
@@ -0,0 +1,18 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include ../Makefile.com
+
+install: all $(ROOTPROG32)
diff --git a/usr/src/cmd/ficl/sparc/Makefile b/usr/src/cmd/ficl/sparc/Makefile
new file mode 100644
index 0000000000..df3cfceab6
--- /dev/null
+++ b/usr/src/cmd/ficl/sparc/Makefile
@@ -0,0 +1,18 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include ../Makefile.com
+
+install: all $(ROOTPROG32)
diff --git a/usr/src/cmd/ficl/sparcv9/Makefile b/usr/src/cmd/ficl/sparcv9/Makefile
new file mode 100644
index 0000000000..5947231d79
--- /dev/null
+++ b/usr/src/cmd/ficl/sparcv9/Makefile
@@ -0,0 +1,19 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include ../Makefile.com
+include ../../Makefile.cmd.64
+
+install: all $(ROOTPROG64)
diff --git a/usr/src/common/ficl/LICENSE b/usr/src/common/ficl/LICENSE
new file mode 100644
index 0000000000..17ef5e848d
--- /dev/null
+++ b/usr/src/common/ficl/LICENSE
@@ -0,0 +1,22 @@
+FICL LICENSE
+
+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.
diff --git a/usr/src/common/ficl/LICENSE.descrip b/usr/src/common/ficl/LICENSE.descrip
new file mode 100644
index 0000000000..962eb00cb9
--- /dev/null
+++ b/usr/src/common/ficl/LICENSE.descrip
@@ -0,0 +1 @@
+FICL
diff --git a/usr/src/common/ficl/ReadMe.txt b/usr/src/common/ficl/ReadMe.txt
new file mode 100644
index 0000000000..83e8e5e799
--- /dev/null
+++ b/usr/src/common/ficl/ReadMe.txt
@@ -0,0 +1,52 @@
+FICL 4.1.0
+October 2010
+
+________
+OVERVIEW
+
+Ficl is a complete programming language interpreter designed to be embedded
+into other systems (including firmware based ones) as a command, macro,
+and development prototype language.  Ficl stands for "Forth Inspired
+Command Language".
+
+For more information, please see the "doc" directory.
+For release notes, please see "doc/releases.html".
+
+____________
+INSTALLATION
+
+Ficl builds out-of-the-box on the following platforms:
+	* NetBSD, FreeBSD: use "Makefile".
+	* Linux: use "Makefile.linux", but it should work with
+	  "Makefile" as well.
+	* Win32: use "ficl.dsw" / "ficl.dsp".
+To port to other platforms, we suggest you start with the generic
+"Makefile" and the "unix.c" / "unix.h" platform-specific implementation
+files.  (And please--feel free to submit your portability changes!)
+
+(Note: Ficl used to build under RiscOS, but we broke everything
+for the 4.0 release.  Please fix it and send us the diffs!)
+
+____________
+FICL LICENSE
+
+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.
diff --git a/usr/src/common/ficl/callback.c b/usr/src/common/ficl/callback.c
new file mode 100644
index 0000000000..fffcf729a8
--- /dev/null
+++ b/usr/src/common/ficl/callback.c
@@ -0,0 +1,67 @@
+#include "ficl.h"
+
+extern ficlSystem *ficlSystemGlobal;
+
+/*
+ * f i c l C a l l b a c k T e x t O u t
+ * Feeds text to the vm's output callback
+ */
+void
+ficlCallbackTextOut(ficlCallback *callback, char *text)
+{
+	ficlOutputFunction textOut = NULL;
+
+	if (callback != NULL) {
+		if (callback->textOut != NULL)
+			textOut = callback->textOut;
+		else if ((callback->system != NULL) &&
+		    (callback != &(callback->system->callback))) {
+			ficlCallbackTextOut(&(callback->system->callback),
+			    text);
+			return;
+		}
+	}
+
+	if ((textOut == NULL) && (ficlSystemGlobal != NULL)) {
+		callback = &(ficlSystemGlobal->callback);
+		textOut = callback->textOut;
+	}
+
+	if (textOut == NULL)
+		textOut = ficlCallbackDefaultTextOut;
+
+	(textOut)(callback, text);
+}
+
+/*
+ * f i c l C a l l b a c k E r r o r O u t
+ * Feeds text to the vm's error output callback
+ */
+void
+ficlCallbackErrorOut(ficlCallback *callback, char *text)
+{
+	ficlOutputFunction errorOut = NULL;
+
+	if (callback != NULL) {
+		if (callback->errorOut != NULL)
+			errorOut = callback->errorOut;
+		else if ((callback->system != NULL) &&
+		    (callback != &(callback->system->callback))) {
+			ficlCallbackErrorOut(&(callback->system->callback),
+			    text);
+			return;
+		}
+	}
+
+	if ((errorOut == NULL) && (ficlSystemGlobal != NULL)) {
+		callback = &(ficlSystemGlobal->callback);
+		errorOut = callback->errorOut;
+	}
+
+	if (errorOut == NULL) {
+		ficlCallbackTextOut(callback, text);
+		return;
+	}
+
+	(errorOut)(callback, text);
+}
diff --git a/usr/src/common/ficl/dictionary.c b/usr/src/common/ficl/dictionary.c
new file mode 100644
index 0000000000..39460e9144
--- /dev/null
+++ b/usr/src/common/ficl/dictionary.c
@@ -0,0 +1,881 @@
+/*
+ * d i c t . c
+ * Forth Inspired Command Language - dictionary methods
+ * Author: John Sadler (john_sadler@alum.mit.edu)
+ * Created: 19 July 1997
+ * $Id: dictionary.c,v 1.2 2010/09/12 15:14:52 asau Exp $
+ */
+/*
+ * This file implements the dictionary -- Ficl's model of
+ * memory management. All Ficl words are stored in the
+ * dictionary. A word is a named chunk of data with its
+ * associated code. Ficl treats all words the same, even
+ * precompiled ones, so your words become first-class
+ * extensions of the language. You can even define new
+ * control structures.
+ *
+ * 29 jun 1998 (sadler) added variable sized hash table support
+ */
+/*
+ * 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.
+ */
+
+#include "ficl.h"
+
+#define	FICL_SAFE_CALLBACK_FROM_SYSTEM(system)		\
+	(((system) != NULL) ? &((system)->callback) : NULL)
+#define	FICL_SAFE_SYSTEM_FROM_DICTIONARY(dictionary)	\
+	(((dictionary) != NULL) ? (dictionary)->system : NULL)
+#define	FICL_DICTIONARY_ASSERT(dictionary, expression)	\
+	FICL_SYSTEM_ASSERT(FICL_SAFE_SYSTEM_FROM_DICTIONARY(dictionary), \
+	expression)
+
+/*
+ * d i c t A b o r t D e f i n i t i o n
+ * Abort a definition in process: reclaim its memory and unlink it
+ * from the dictionary list. Assumes that there is a smudged
+ * definition in process...otherwise does nothing.
+ * NOTE: this function is not smart enough to unlink a word that
+ * has been successfully defined (ie linked into a hash). It
+ * only works for defs in process. If the def has been unsmudged,
+ * nothing happens.
+ */
+void
+ficlDictionaryAbortDefinition(ficlDictionary *dictionary)
+{
+	ficlWord *word;
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+	word = dictionary->smudge;
+
+	if (word->flags & FICL_WORD_SMUDGED)
+		dictionary->here = (ficlCell *)word->name;
+
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+}
+
+/*
+ * d i c t A l i g n
+ * Align the dictionary's free space pointer
+ */
+void
+ficlDictionaryAlign(ficlDictionary *dictionary)
+{
+	dictionary->here = ficlAlignPointer(dictionary->here);
+}
+
+/*
+ * d i c t A l l o t
+ * Allocate or remove n chars of dictionary space, with
+ * checks for underrun and overrun
+ */
+void
+ficlDictionaryAllot(ficlDictionary *dictionary, int n)
+{
+	char *here = (char *)dictionary->here;
+	here += n;
+	dictionary->here = FICL_POINTER_TO_CELL(here);
+}
+
+/*
+ * d i c t A l l o t C e l l s
+ * Reserve space for the requested number of ficlCells in the
+ * dictionary. If nficlCells < 0 , removes space from the dictionary.
+ */
+void
+ficlDictionaryAllotCells(ficlDictionary *dictionary, int nficlCells)
+{
+	dictionary->here += nficlCells;
+}
+
+/*
+ * d i c t A p p e n d C e l l
+ * Append the specified ficlCell to the dictionary
+ */
+void
+ficlDictionaryAppendCell(ficlDictionary *dictionary, ficlCell c)
+{
+	*dictionary->here++ = c;
+}
+
+/*
+ * d i c t A p p e n d C h a r
+ * Append the specified char to the dictionary
+ */
+void
+ficlDictionaryAppendCharacter(ficlDictionary *dictionary, char c)
+{
+	char *here = (char *)dictionary->here;
+	*here++ = c;
+	dictionary->here = FICL_POINTER_TO_CELL(here);
+}
+
+/*
+ * d i c t A p p e n d U N S
+ * Append the specified ficlUnsigned to the dictionary
+ */
+void
+ficlDictionaryAppendUnsigned(ficlDictionary *dictionary, ficlUnsigned u)
+{
+	ficlCell c;
+
+	c.u = u;
+	ficlDictionaryAppendCell(dictionary, c);
+}
+
+void *
+ficlDictionaryAppendData(ficlDictionary *dictionary, void *data,
+    ficlInteger length)
+{
+	char *here = (char *)dictionary->here;
+	char *oldHere = here;
+	char *from = (char *)data;
+
+	if (length == 0) {
+		ficlDictionaryAlign(dictionary);
+		return ((char *)dictionary->here);
+	}
+
+	while (length) {
+		*here++ = *from++;
+		length--;
+	}
+
+	*here++ = '\0';
+
+	dictionary->here = FICL_POINTER_TO_CELL(here);
+	ficlDictionaryAlign(dictionary);
+	return (oldHere);
+}
+
+/*
+ * d i c t C o p y N a m e
+ * Copy up to FICL_NAME_LENGTH characters of the name specified by s into
+ * the dictionary starting at "here", then NULL-terminate the name,
+ * point "here" to the next available byte, and return the address of
+ * the beginning of the name. Used by dictAppendWord.
+ * N O T E S :
+ * 1. "here" is guaranteed to be aligned after this operation.
+ * 2. If the string has zero length, align and return "here"
+ */
+char *
+ficlDictionaryAppendString(ficlDictionary *dictionary, ficlString s)
+{
+	void *data = FICL_STRING_GET_POINTER(s);
+	ficlInteger length = FICL_STRING_GET_LENGTH(s);
+
+	if (length > FICL_NAME_LENGTH)
+		length = FICL_NAME_LENGTH;
+
+	return (ficlDictionaryAppendData(dictionary, data, length));
+}
+
+ficlWord *
+ficlDictionaryAppendConstantInstruction(ficlDictionary *dictionary,
+    ficlString name, ficlInstruction instruction, ficlInteger value)
+{
+	ficlWord *word = ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)instruction, FICL_WORD_DEFAULT);
+
+	if (word != NULL)
+		ficlDictionaryAppendUnsigned(dictionary, value);
+	return (word);
+}
+
+ficlWord *
+ficlDictionaryAppend2ConstantInstruction(ficlDictionary *dictionary,
+    ficlString name, ficlInstruction instruction, ficl2Integer value)
+{
+	ficlWord *word = ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)instruction, FICL_WORD_DEFAULT);
+
+	if (word != NULL) {
+		ficlDictionaryAppendUnsigned(dictionary,
+		    FICL_2UNSIGNED_GET_HIGH(value));
+		ficlDictionaryAppendUnsigned(dictionary,
+		    FICL_2UNSIGNED_GET_LOW(value));
+	}
+	return (word);
+}
+
+ficlWord *
+ficlDictionaryAppendConstant(ficlDictionary *dictionary, char *name,
+    ficlInteger value)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+	return (ficlDictionaryAppendConstantInstruction(dictionary, s,
+	    ficlInstructionConstantParen, value));
+}
+
+ficlWord *
+ficlDictionaryAppend2Constant(ficlDictionary *dictionary, char *name,
+    ficl2Integer value)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+	return (ficlDictionaryAppend2ConstantInstruction(dictionary, s,
+	    ficlInstruction2ConstantParen, value));
+}
+
+ficlWord *
+ficlDictionarySetConstantInstruction(ficlDictionary *dictionary,
+    ficlString name, ficlInstruction instruction, ficlInteger value)
+{
+	ficlWord *word = ficlDictionaryLookup(dictionary, name);
+	ficlCell c;
+
+	if (word == NULL) {
+		word = ficlDictionaryAppendConstantInstruction(dictionary,
+		    name, instruction, value);
+	} else {
+		word->code = (ficlPrimitive)instruction;
+		c.i = value;
+		word->param[0] = c;
+	}
+	return (word);
+}
+
+ficlWord *
+ficlDictionarySetConstant(ficlDictionary *dictionary, char *name,
+    ficlInteger value)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+	return (ficlDictionarySetConstantInstruction(dictionary, s,
+	    ficlInstructionConstantParen, value));
+}
+
+ficlWord *
+ficlDictionarySet2ConstantInstruction(ficlDictionary *dictionary, ficlString s,
+    ficlInstruction instruction, ficl2Integer value)
+{
+	ficlWord *word;
+	word = ficlDictionaryLookup(dictionary, s);
+
+	/*
+	 * only reuse the existing word if we're sure it has space for a
+	 * 2constant
+	 */
+#if FICL_WANT_FLOAT
+	if ((word != NULL) &&
+	    ((((ficlInstruction)word->code) == ficlInstruction2ConstantParen) ||
+	    (((ficlInstruction)word->code) == ficlInstructionF2ConstantParen)))
+#else
+	if ((word != NULL) &&
+	    ((((ficlInstruction)word->code) == ficlInstruction2ConstantParen)))
+#endif /* FICL_WANT_FLOAT */
+	{
+		word->code = (ficlPrimitive)instruction;
+		word->param[0].u = FICL_2UNSIGNED_GET_HIGH(value);
+		word->param[1].u = FICL_2UNSIGNED_GET_LOW(value);
+	} else {
+		word = ficlDictionaryAppend2ConstantInstruction(dictionary, s,
+		    instruction, value);
+	}
+
+	return (word);
+}
+
+ficlWord *
+ficlDictionarySet2Constant(ficlDictionary *dictionary, char *name,
+    ficl2Integer value)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+
+	return (ficlDictionarySet2ConstantInstruction(dictionary, s,
+	    ficlInstruction2ConstantParen, value));
+}
+
+ficlWord *
+ficlDictionarySetConstantString(ficlDictionary *dictionary, char *name,
+    char *value)
+{
+	ficlString s;
+	ficl2Integer valueAs2Integer;
+	FICL_2INTEGER_SET(strlen(value), (intptr_t)value, valueAs2Integer);
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+
+	return (ficlDictionarySet2ConstantInstruction(dictionary, s,
+	    ficlInstruction2ConstantParen, valueAs2Integer));
+}
+
+/*
+ * d i c t A p p e n d W o r d
+ * Create a new word in the dictionary with the specified
+ * ficlString, code, and flags. Does not require a NULL-terminated
+ * name.
+ */
+ficlWord *
+ficlDictionaryAppendWord(ficlDictionary *dictionary, ficlString name,
+    ficlPrimitive code, ficlUnsigned8 flags)
+{
+	ficlUnsigned8 length = (ficlUnsigned8)FICL_STRING_GET_LENGTH(name);
+	char *nameCopy;
+	ficlWord *word;
+
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+
+	/*
+	 * NOTE: ficlDictionaryAppendString advances "here" as a side-effect.
+	 * It must execute before word is initialized.
+	 */
+	nameCopy = ficlDictionaryAppendString(dictionary, name);
+	word = (ficlWord *)dictionary->here;
+	dictionary->smudge = word;
+	word->hash = ficlHashCode(name);
+	word->code = code;
+	word->semiParen = ficlInstructionSemiParen;
+	word->flags = (ficlUnsigned8)(flags | FICL_WORD_SMUDGED);
+	word->length = length;
+	word->name = nameCopy;
+
+	/*
+	 * Point "here" to first ficlCell of new word's param area...
+	 */
+	dictionary->here = word->param;
+
+	if (!(flags & FICL_WORD_SMUDGED))
+		ficlDictionaryUnsmudge(dictionary);
+
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+	return (word);
+}
+
+/*
+ * d i c t A p p e n d W o r d
+ * Create a new word in the dictionary with the specified
+ * name, code, and flags. Name must be NULL-terminated.
+ */
+ficlWord *
+ficlDictionaryAppendPrimitive(ficlDictionary *dictionary, char *name,
+    ficlPrimitive code, ficlUnsigned8 flags)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+
+	return (ficlDictionaryAppendWord(dictionary, s, code, flags));
+}
+
+ficlWord *
+ficlDictionarySetPrimitive(ficlDictionary *dictionary, char *name,
+    ficlPrimitive code, ficlUnsigned8 flags)
+{
+	ficlString s;
+	ficlWord *word;
+
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+	word = ficlDictionaryLookup(dictionary, s);
+
+	if (word == NULL) {
+		word = ficlDictionaryAppendPrimitive(dictionary, name,
+		    code, flags);
+	} else {
+		word->code = (ficlPrimitive)code;
+		word->flags = flags;
+	}
+	return (word);
+}
+
+ficlWord *
+ficlDictionaryAppendInstruction(ficlDictionary *dictionary, char *name,
+    ficlInstruction i, ficlUnsigned8 flags)
+{
+	return (ficlDictionaryAppendPrimitive(dictionary, name,
+	    (ficlPrimitive)i, (ficlUnsigned8)(FICL_WORD_INSTRUCTION | flags)));
+}
+
+ficlWord *
+ficlDictionarySetInstruction(ficlDictionary *dictionary, char *name,
+    ficlInstruction i, ficlUnsigned8 flags)
+{
+	return (ficlDictionarySetPrimitive(dictionary, name,
+	    (ficlPrimitive)i, (ficlUnsigned8)(FICL_WORD_INSTRUCTION | flags)));
+}
+
+/*
+ * d i c t C e l l s A v a i l
+ * Returns the number of empty ficlCells left in the dictionary
+ */
+int
+ficlDictionaryCellsAvailable(ficlDictionary *dictionary)
+{
+	return (dictionary->size - ficlDictionaryCellsUsed(dictionary));
+}
+
+/*
+ * d i c t C e l l s U s e d
+ * Returns the number of ficlCells consumed in the dicionary
+ */
+int
+ficlDictionaryCellsUsed(ficlDictionary *dictionary)
+{
+	return (dictionary->here - dictionary->base);
+}
+
+/*
+ * d i c t C r e a t e
+ * Create and initialize a dictionary with the specified number
+ * of ficlCells capacity, and no hashing (hash size == 1).
+ */
+ficlDictionary *
+ficlDictionaryCreate(ficlSystem *system, unsigned size)
+{
+	return (ficlDictionaryCreateHashed(system, size, 1));
+}
+
+ficlDictionary *
+ficlDictionaryCreateHashed(ficlSystem *system, unsigned size,
+    unsigned bucketCount)
+{
+	ficlDictionary *dictionary;
+	size_t nAlloc;
+
+	nAlloc =  sizeof (ficlDictionary) + (size * sizeof (ficlCell))
+	    + sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *);
+
+	dictionary = ficlMalloc(nAlloc);
+	FICL_SYSTEM_ASSERT(system, dictionary != NULL);
+
+	dictionary->size = size;
+	dictionary->system = system;
+
+	ficlDictionaryEmpty(dictionary, bucketCount);
+	return (dictionary);
+}
+
+/*
+ * d i c t C r e a t e W o r d l i s t
+ * Create and initialize an anonymous wordlist
+ */
+ficlHash *
+ficlDictionaryCreateWordlist(ficlDictionary *dictionary, int bucketCount)
+{
+	ficlHash *hash;
+
+	ficlDictionaryAlign(dictionary);
+	hash = (ficlHash *)dictionary->here;
+	ficlDictionaryAllot(dictionary,
+	    sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *));
+
+	hash->size = bucketCount;
+	ficlHashReset(hash);
+	return (hash);
+}
+
+/*
+ * d i c t D e l e t e
+ * Free all memory allocated for the given dictionary
+ */
+void
+ficlDictionaryDestroy(ficlDictionary *dictionary)
+{
+	FICL_DICTIONARY_ASSERT(dictionary, dictionary != NULL);
+	ficlFree(dictionary);
+}
+
+/*
+ * d i c t E m p t y
+ * Empty the dictionary, reset its hash table, and reset its search order.
+ * Clears and (re-)creates the hash table with the size specified by nHash.
+ */
+void
+ficlDictionaryEmpty(ficlDictionary *dictionary, unsigned bucketCount)
+{
+	ficlHash *hash;
+
+	dictionary->here = dictionary->base;
+
+	ficlDictionaryAlign(dictionary);
+	hash = (ficlHash *)dictionary->here;
+	ficlDictionaryAllot(dictionary,
+	    sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *));
+
+	hash->size = bucketCount;
+	ficlHashReset(hash);
+
+	dictionary->forthWordlist = hash;
+	dictionary->smudge = NULL;
+	ficlDictionaryResetSearchOrder(dictionary);
+}
+
+/*
+ * 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
+ficlDictionaryIsAWord(ficlDictionary *dictionary, ficlWord *word)
+{
+	if ((((ficlInstruction)word) > ficlInstructionInvalid) &&
+	    (((ficlInstruction)word) < ficlInstructionLast))
+		return (1);
+
+	if (!ficlDictionaryIncludes(dictionary, word))
+		return (0);
+
+	if (!ficlDictionaryIncludes(dictionary, word->name))
+		return (0);
+
+	if ((word->link != NULL) &&
+	    !ficlDictionaryIncludes(dictionary, word->link))
+		return (0);
+
+	if ((word->length <= 0) || (word->name[word->length] != '\0'))
+		return (0);
+
+	if (strlen(word->name) != word->length)
+		return (0);
+
+	return (1);
+}
+
+/*
+ * 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
+ * ficlWord found. Otherwise return NULL. nSEARCH_CELLS sets the maximum
+ * neighborhood this func will search before giving up
+ */
+#define	nSEARCH_CELLS	100
+
+ficlWord *
+ficlDictionaryFindEnclosingWord(ficlDictionary *dictionary, ficlCell *cell)
+{
+	ficlWord *word;
+	int i;
+
+	if (!ficlDictionaryIncludes(dictionary, (void *)cell))
+		return (NULL);
+
+	for (i = nSEARCH_CELLS; i > 0; --i, --cell) {
+		word = (ficlWord *)
+		    (cell + 1 - (sizeof (ficlWord) / sizeof (ficlCell)));
+		if (ficlDictionaryIsAWord(dictionary, word))
+			return (word);
+	}
+
+	return (NULL);
+}
+
+/*
+ * d i c t I n c l u d e s
+ * Returns FICL_TRUE iff the given pointer is within the address range of
+ * the dictionary.
+ */
+int
+ficlDictionaryIncludes(ficlDictionary *dictionary, void *p)
+{
+	return ((p >= (void *) &dictionary->base) &&
+	    (p <  (void *)(&dictionary->base + dictionary->size)));
+}
+
+/*
+ * d i c t L o o k u p
+ * Find the ficlWord that matches the given name and length.
+ * If found, returns the word's address. Otherwise returns NULL.
+ * Uses the search order list to search multiple wordlists.
+ */
+ficlWord *
+ficlDictionaryLookup(ficlDictionary *dictionary, ficlString name)
+{
+	ficlWord *word = NULL;
+	ficlHash *hash;
+	int i;
+	ficlUnsigned16 hashCode = ficlHashCode(name);
+
+	FICL_DICTIONARY_ASSERT(dictionary, dictionary != NULL);
+
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+
+	for (i = (int)dictionary->wordlistCount - 1; (i >= 0) && (!word); --i) {
+		hash = dictionary->wordlists[i];
+		word = ficlHashLookup(hash, name, hashCode);
+	}
+
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+	return (word);
+}
+
+/*
+ * s e e
+ * TOOLS ( "<spaces>name" -- )
+ * Display a human-readable representation of the named word's definition.
+ * The source of the representation (object-code decompilation, source
+ * block, etc.) and the particular form of the display is implementation
+ * defined.
+ */
+/*
+ * ficlSeeColon (for proctologists only)
+ * Walks a colon definition, decompiling
+ * on the fly. Knows about primitive control structures.
+ */
+char *ficlDictionaryInstructionNames[] =
+{
+#define	FICL_TOKEN(token, description)	description,
+#define	FICL_INSTRUCTION_TOKEN(token, description, flags)	description,
+#include "ficltokens.h"
+#undef FICL_TOKEN
+#undef FICL_INSTRUCTION_TOKEN
+};
+
+void
+ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word,
+    ficlCallback *callback)
+{
+	char *trace;
+	ficlCell *cell = word->param;
+	ficlCell *param0 = cell;
+	char buffer[128];
+
+	for (; cell->i != ficlInstructionSemiParen; cell++) {
+		ficlWord *word = (ficlWord *)(cell->p);
+
+		trace = buffer;
+		if ((void *)cell == (void *)buffer)
+			*trace++ = '>';
+		else
+			*trace++ = ' ';
+		trace += sprintf(trace, "%3ld   ", (long)(cell - param0));
+
+		if (ficlDictionaryIsAWord(dictionary, word)) {
+			ficlWordKind kind = ficlWordClassify(word);
+			ficlCell c, c2;
+
+			switch (kind) {
+			case FICL_WORDKIND_INSTRUCTION:
+				sprintf(trace, "%s (instruction %ld)",
+				    ficlDictionaryInstructionNames[(long)word],
+				    (long)word);
+			break;
+			case FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT:
+				c = *++cell;
+				sprintf(trace, "%s (instruction %ld), with "
+				    "argument %ld (%#lx)",
+				    ficlDictionaryInstructionNames[(long)word],
+				    (long)word, (long)c.i, (unsigned long)c.u);
+			break;
+			case FICL_WORDKIND_INSTRUCTION_WORD:
+				sprintf(trace,
+				    "%s :: executes %s (instruction word %ld)",
+				    word->name,
+				    ficlDictionaryInstructionNames[
+				    (long)word->code], (long)word->code);
+			break;
+			case FICL_WORDKIND_LITERAL:
+				c = *++cell;
+				if (ficlDictionaryIsAWord(dictionary, c.p) &&
+				    (c.i >= ficlInstructionLast)) {
+					ficlWord *word = (ficlWord *)c.p;
+					sprintf(trace, "%.*s ( %#lx literal )",
+					    word->length, word->name,
+					    (unsigned long)c.u);
+				} else
+					sprintf(trace,
+					    "literal %ld (%#lx)", (long)c.i,
+					    (unsigned long)c.u);
+			break;
+			case FICL_WORDKIND_2LITERAL:
+				c = *++cell;
+				c2 = *++cell;
+				sprintf(trace, "2literal %ld %ld (%#lx %#lx)",
+				    (long)c2.i, (long)c.i, (unsigned long)c2.u,
+				    (unsigned long)c.u);
+			break;
+#if FICL_WANT_FLOAT
+			case FICL_WORDKIND_FLITERAL:
+				c = *++cell;
+				sprintf(trace, "fliteral %f (%#lx)",
+				    (double)c.f, (unsigned long)c.u);
+			break;
+#endif /* FICL_WANT_FLOAT */
+			case FICL_WORDKIND_STRING_LITERAL: {
+				ficlCountedString *counted;
+				counted = (ficlCountedString *)(void *)++cell;
+				cell = (ficlCell *)
+				    ficlAlignPointer(counted->text +
+				    counted->length + 1) - 1;
+				sprintf(trace, "s\" %.*s\"", counted->length,
+				    counted->text);
+			}
+			break;
+			case FICL_WORDKIND_CSTRING_LITERAL: {
+				ficlCountedString *counted;
+				counted = (ficlCountedString *)(void *)++cell;
+				cell = (ficlCell *)
+				    ficlAlignPointer(counted->text +
+				    counted->length + 1) - 1;
+				sprintf(trace, "c\" %.*s\"", counted->length,
+				    counted->text);
+			}
+			break;
+			case FICL_WORDKIND_BRANCH0:
+				c = *++cell;
+				sprintf(trace, "branch0 %ld",
+				    (long)(cell + c.i - param0));
+			break;
+			case FICL_WORDKIND_BRANCH:
+				c = *++cell;
+				sprintf(trace, "branch %ld",
+				    (long)(cell + c.i - param0));
+			break;
+
+			case FICL_WORDKIND_QDO:
+				c = *++cell;
+				sprintf(trace, "?do (leave %ld)",
+				    (long)((ficlCell *)c.p - param0));
+			break;
+			case FICL_WORDKIND_DO:
+				c = *++cell;
+				sprintf(trace, "do (leave %ld)",
+				    (long)((ficlCell *)c.p - param0));
+			break;
+			case FICL_WORDKIND_LOOP:
+				c = *++cell;
+				sprintf(trace, "loop (branch %ld)",
+				    (long)(cell + c.i - param0));
+			break;
+			case FICL_WORDKIND_OF:
+				c = *++cell;
+				sprintf(trace, "of (branch %ld)",
+				    (long)(cell + c.i - param0));
+			break;
+			case FICL_WORDKIND_PLOOP:
+				c = *++cell;
+				sprintf(trace, "+loop (branch %ld)",
+				    (long)(cell + c.i - param0));
+			break;
+			default:
+				sprintf(trace, "%.*s", word->length,
+				    word->name);
+			break;
+			}
+		} else {
+			/* probably not a word - punt and print value */
+			sprintf(trace, "%ld ( %#lx )", (long)cell->i,
+			    (unsigned long)cell->u);
+		}
+
+		ficlCallbackTextOut(callback, buffer);
+		ficlCallbackTextOut(callback, "\n");
+	}
+
+	ficlCallbackTextOut(callback, ";\n");
+}
+
+/*
+ * d i c t R e s e t S e a r c h O r d e r
+ * Initialize the dictionary search order list to sane state
+ */
+void
+ficlDictionaryResetSearchOrder(ficlDictionary *dictionary)
+{
+	FICL_DICTIONARY_ASSERT(dictionary, dictionary);
+	dictionary->compilationWordlist = dictionary->forthWordlist;
+	dictionary->wordlistCount = 1;
+	dictionary->wordlists[0] = dictionary->forthWordlist;
+}
+
+/*
+ * d i c t S e t F l a g s
+ * Changes the flags field of the most recently defined word:
+ * Set all bits that are ones in the set parameter.
+ */
+void
+ficlDictionarySetFlags(ficlDictionary *dictionary, ficlUnsigned8 set)
+{
+	FICL_DICTIONARY_ASSERT(dictionary, dictionary->smudge);
+	dictionary->smudge->flags |= set;
+}
+
+
+/*
+ * d i c t C l e a r F l a g s
+ * Changes the flags field of the most recently defined word:
+ * Clear all bits that are ones in the clear parameter.
+ */
+void
+ficlDictionaryClearFlags(ficlDictionary *dictionary, ficlUnsigned8 clear)
+{
+	FICL_DICTIONARY_ASSERT(dictionary, dictionary->smudge);
+	dictionary->smudge->flags &= ~clear;
+}
+
+/*
+ * d i c t S e t I m m e d i a t e
+ * Set the most recently defined word as IMMEDIATE
+ */
+void
+ficlDictionarySetImmediate(ficlDictionary *dictionary)
+{
+	FICL_DICTIONARY_ASSERT(dictionary, dictionary->smudge);
+	dictionary->smudge->flags |= FICL_WORD_IMMEDIATE;
+}
+
+/*
+ * d i c t U n s m u d g e
+ * Completes the definition of a word by linking it
+ * into the main list
+ */
+void
+ficlDictionaryUnsmudge(ficlDictionary *dictionary)
+{
+	ficlWord *word = dictionary->smudge;
+	ficlHash *hash = dictionary->compilationWordlist;
+
+	FICL_DICTIONARY_ASSERT(dictionary, hash);
+	FICL_DICTIONARY_ASSERT(dictionary, word);
+
+	/*
+	 * :noname words never get linked into the list...
+	 */
+	if (word->length > 0)
+		ficlHashInsertWord(hash, word);
+	word->flags &= ~(FICL_WORD_SMUDGED);
+}
+
+/*
+ * d i c t W h e r e
+ * Returns the value of the HERE pointer -- the address
+ * of the next free ficlCell in the dictionary
+ */
+ficlCell *
+ficlDictionaryWhere(ficlDictionary *dictionary)
+{
+	return (dictionary->here);
+}
diff --git a/usr/src/common/ficl/double.c b/usr/src/common/ficl/double.c
new file mode 100644
index 0000000000..c8b406cac6
--- /dev/null
+++ b/usr/src/common/ficl/double.c
@@ -0,0 +1,440 @@
+/*
+ * m a t h 6 4 . c
+ * Forth Inspired Command Language - 64 bit math support routines
+ * Authors: Michael A. Gauland (gaulandm@mdhost.cse.tek.com)
+ *          Larry Hastings (larry@hastings.org)
+ *          John Sadler (john_sadler@alum.mit.edu)
+ * Created: 25 January 1998
+ * Rev 2.03: Support for 128 bit DP math. This file really ouught to
+ * be renamed!
+ * $Id: double.c,v 1.2 2010/09/12 15:18:07 asau 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.
+ */
+
+#include "ficl.h"
+
+#if FICL_PLATFORM_HAS_2INTEGER
+ficl2UnsignedQR
+ficl2UnsignedDivide(ficl2Unsigned q, ficlUnsigned y)
+{
+	ficl2UnsignedQR result;
+
+	result.quotient = q / y;
+	/*
+	 * Once we have the quotient, it's cheaper to calculate the
+	 * remainder this way than with % (mod).  --lch
+	 */
+	result.remainder  = (ficlInteger)(q - (result.quotient * y));
+
+	return (result);
+}
+
+#else  /* FICL_PLATFORM_HAS_2INTEGER */
+
+#define	FICL_CELL_HIGH_BIT	((uintmax_t)1 << (FICL_BITS_PER_CELL-1))
+#define	UMOD_SHIFT		(FICL_BITS_PER_CELL / 2)
+#define	UMOD_MASK		((1L << (FICL_BITS_PER_CELL / 2)) - 1)
+
+/*
+ * ficl2IntegerIsNegative
+ * Returns TRUE if the specified ficl2Unsigned has its sign bit set.
+ */
+int
+ficl2IntegerIsNegative(ficl2Integer x)
+{
+	return (x.high < 0);
+}
+
+/*
+ * ficl2IntegerNegate
+ * Negates an ficl2Unsigned by complementing and incrementing.
+ */
+ficl2Integer
+ficl2IntegerNegate(ficl2Integer x)
+{
+	x.high = ~x.high;
+	x.low = ~x.low;
+	x.low ++;
+	if (x.low == 0)
+		x.high++;
+
+	return (x);
+}
+
+/*
+ * ficl2UnsignedMultiplyAccumulate
+ * Mixed precision multiply and accumulate primitive for number building.
+ * Multiplies ficl2Unsigned u by ficlUnsigned mul and adds ficlUnsigned add.
+ * Mul is typically the numeric base, and add represents a digit to be
+ * appended to the growing number.
+ * Returns the result of the operation
+ */
+ficl2Unsigned
+ficl2UnsignedMultiplyAccumulate(ficl2Unsigned u, ficlUnsigned mul,
+    ficlUnsigned add)
+{
+	ficl2Unsigned resultLo = ficl2UnsignedMultiply(u.low, mul);
+	ficl2Unsigned resultHi = ficl2UnsignedMultiply(u.high, mul);
+	resultLo.high += resultHi.low;
+	resultHi.low = resultLo.low + add;
+
+	if (resultHi.low < resultLo.low)
+		resultLo.high++;
+
+	resultLo.low = resultHi.low;
+
+	return (resultLo);
+}
+
+/*
+ * ficl2IntegerMultiply
+ * Multiplies a pair of ficlIntegers and returns an ficl2Integer result.
+ */
+ficl2Integer
+ficl2IntegerMultiply(ficlInteger x, ficlInteger y)
+{
+	ficl2Unsigned prod;
+	ficl2Integer result;
+	int sign = 1;
+
+	if (x < 0) {
+		sign = -sign;
+		x = -x;
+	}
+
+	if (y < 0) {
+		sign = -sign;
+		y = -y;
+	}
+
+	prod = ficl2UnsignedMultiply(x, y);
+	FICL_2INTEGER_SET(FICL_2UNSIGNED_GET_HIGH(prod),
+	    FICL_2UNSIGNED_GET_LOW(prod), result);
+	if (sign > 0)
+		return (result);
+	else
+		return (ficl2IntegerNegate(result));
+}
+
+ficl2Integer
+ficl2IntegerDecrement(ficl2Integer x)
+{
+	if (x.low == INTMAX_MIN)
+		x.high--;
+	x.low--;
+
+	return (x);
+}
+
+ficl2Unsigned
+ficl2UnsignedAdd(ficl2Unsigned x, ficl2Unsigned y)
+{
+	ficl2Unsigned result;
+
+	result.high = x.high + y.high;
+	result.low = x.low + y.low;
+
+	if (result.low < y.low)
+		result.high++;
+
+	return (result);
+}
+
+/*
+ * ficl2UnsignedMultiply
+ * Contributed by:
+ * Michael A. Gauland   gaulandm@mdhost.cse.tek.com
+ */
+ficl2Unsigned
+ficl2UnsignedMultiply(ficlUnsigned x, ficlUnsigned y)
+{
+	ficl2Unsigned result = { 0, 0 };
+	ficl2Unsigned addend;
+
+	addend.low = y;
+	addend.high = 0; /* No sign extension--arguments are unsigned */
+
+	while (x != 0) {
+		if (x & 1) {
+			result = ficl2UnsignedAdd(result, addend);
+		}
+		x >>= 1;
+		addend = ficl2UnsignedArithmeticShiftLeft(addend);
+	}
+	return (result);
+}
+
+/*
+ *                      ficl2UnsignedSubtract
+ */
+ficl2Unsigned
+ficl2UnsignedSubtract(ficl2Unsigned x, ficl2Unsigned y)
+{
+	ficl2Unsigned result;
+
+	result.high = x.high - y.high;
+	result.low = x.low - y.low;
+
+	if (x.low < y.low) {
+		result.high--;
+	}
+
+	return (result);
+}
+
+/*
+ * ficl2UnsignedArithmeticShiftLeft
+ * 64 bit left shift
+ */
+ficl2Unsigned
+ficl2UnsignedArithmeticShiftLeft(ficl2Unsigned x)
+{
+	ficl2Unsigned result;
+
+	result.high = x.high << 1;
+	if (x.low & FICL_CELL_HIGH_BIT) {
+		result.high++;
+	}
+
+	result.low = x.low << 1;
+
+	return (result);
+}
+
+/*
+ * ficl2UnsignedArithmeticShiftRight
+ * 64 bit right shift (unsigned - no sign extend)
+ */
+ficl2Unsigned
+ficl2UnsignedArithmeticShiftRight(ficl2Unsigned x)
+{
+	ficl2Unsigned result;
+
+	result.low = x.low >> 1;
+	if (x.high & 1) {
+		result.low |= FICL_CELL_HIGH_BIT;
+	}
+
+	result.high = x.high >> 1;
+	return (result);
+}
+
+/*
+ * ficl2UnsignedOr
+ * 64 bit bitwise OR
+ */
+ficl2Unsigned
+ficl2UnsignedOr(ficl2Unsigned x, ficl2Unsigned y)
+{
+	ficl2Unsigned result;
+
+	result.high = x.high | y.high;
+	result.low = x.low | y.low;
+
+	return (result);
+}
+
+/*
+ * ficl2UnsignedCompare
+ * Return -1 if x < y; 0 if x==y, and 1 if x > y.
+ */
+int
+ficl2UnsignedCompare(ficl2Unsigned x, ficl2Unsigned y)
+{
+	if (x.high > y.high)
+		return (1);
+	if (x.high < y.high)
+		return (-1);
+
+	/* High parts are equal */
+
+	if (x.low > y.low)
+		return (1);
+	else if (x.low < y.low)
+		return (-1);
+
+	return (0);
+}
+
+/*
+ * ficl2UnsignedDivide
+ * Portable versions of ficl2Multiply and ficl2Divide in C
+ * Contributed by:
+ * Michael A. Gauland   gaulandm@mdhost.cse.tek.com
+ */
+ficl2UnsignedQR
+ficl2UnsignedDivide(ficl2Unsigned q, ficlUnsigned y)
+{
+	ficl2UnsignedQR result;
+	ficl2Unsigned quotient;
+	ficl2Unsigned subtrahend;
+	ficl2Unsigned mask;
+
+	quotient.low = 0;
+	quotient.high = 0;
+
+	subtrahend.low = y;
+	subtrahend.high = 0;
+
+	mask.low = 1;
+	mask.high = 0;
+
+	while ((ficl2UnsignedCompare(subtrahend, q) < 0) &&
+	    (subtrahend.high & FICL_CELL_HIGH_BIT) == 0) {
+		mask = ficl2UnsignedArithmeticShiftLeft(mask);
+		subtrahend = ficl2UnsignedArithmeticShiftLeft(subtrahend);
+	}
+
+	while (mask.low != 0 || mask.high != 0) {
+		if (ficl2UnsignedCompare(subtrahend, q) <= 0) {
+			q = ficl2UnsignedSubtract(q, subtrahend);
+			quotient = ficl2UnsignedOr(quotient, mask);
+		}
+		mask = ficl2UnsignedArithmeticShiftRight(mask);
+		subtrahend = ficl2UnsignedArithmeticShiftRight(subtrahend);
+	}
+
+	result.quotient = quotient;
+	result.remainder = q.low;
+	return (result);
+}
+#endif /* !FICL_PLATFORM_HAS_2INTEGER */
+
+/*
+ * ficl2IntegerDivideFloored
+ *
+ * FROM THE FORTH ANS...
+ * Floored division is integer division in which the remainder carries
+ * the sign of the divisor or is zero, and the quotient is rounded to
+ * its arithmetic floor. Symmetric division is integer division in which
+ * the remainder carries the sign of the dividend or is zero and the
+ * quotient is the mathematical quotient rounded towards zero or
+ * truncated. Examples of each are shown in tables 3.3 and 3.4.
+ *
+ * Table 3.3 - Floored Division Example
+ * Dividend        Divisor Remainder       Quotient
+ * --------        ------- ---------       --------
+ *  10                7       3                1
+ * -10                7       4               -2
+ *  10               -7      -4               -2
+ * -10               -7      -3                1
+ *
+ *
+ * Table 3.4 - Symmetric Division Example
+ * Dividend        Divisor Remainder       Quotient
+ * --------        ------- ---------       --------
+ *  10                7       3                1
+ * -10                7      -3               -1
+ *  10               -7       3               -1
+ * -10               -7      -3                1
+ */
+ficl2IntegerQR
+ficl2IntegerDivideFloored(ficl2Integer num, ficlInteger den)
+{
+	ficl2IntegerQR qr;
+	ficl2UnsignedQR uqr;
+	ficl2Unsigned u;
+	int signRem = 1;
+	int signQuot = 1;
+
+	if (ficl2IntegerIsNegative(num)) {
+		num = ficl2IntegerNegate(num);
+		signQuot = -signQuot;
+	}
+
+	if (den < 0) {
+		den = -den;
+		signRem = -signRem;
+		signQuot = -signQuot;
+	}
+
+	FICL_2UNSIGNED_SET(FICL_2UNSIGNED_GET_HIGH(num),
+	    FICL_2UNSIGNED_GET_LOW(num), u);
+	uqr = ficl2UnsignedDivide(u, (ficlUnsigned)den);
+	qr = FICL_2UNSIGNEDQR_TO_2INTEGERQR(uqr);
+	if (signQuot < 0) {
+		qr.quotient = ficl2IntegerNegate(qr.quotient);
+		if (qr.remainder != 0) {
+			qr.quotient = ficl2IntegerDecrement(qr.quotient);
+			qr.remainder = den - qr.remainder;
+		}
+	}
+
+	if (signRem < 0)
+		qr.remainder = -qr.remainder;
+
+	return (qr);
+}
+
+/*
+ * ficl2IntegerDivideSymmetric
+ * Divide an ficl2Unsigned by a ficlInteger and return a ficlInteger quotient
+ * and a ficlInteger remainder. The absolute values of quotient and remainder
+ * are not affected by the signs of the numerator and denominator
+ * (the operation is symmetric on the number line)
+ */
+ficl2IntegerQR
+ficl2IntegerDivideSymmetric(ficl2Integer num, ficlInteger den)
+{
+	ficl2IntegerQR qr;
+	ficl2UnsignedQR uqr;
+	ficl2Unsigned u;
+	int signRem = 1;
+	int signQuot = 1;
+
+	if (ficl2IntegerIsNegative(num)) {
+		num = ficl2IntegerNegate(num);
+		signRem  = -signRem;
+		signQuot = -signQuot;
+	}
+
+	if (den < 0) {
+		den = -den;
+		signQuot = -signQuot;
+	}
+
+	FICL_2UNSIGNED_SET(FICL_2UNSIGNED_GET_HIGH(num),
+	    FICL_2UNSIGNED_GET_LOW(num), u);
+	uqr = ficl2UnsignedDivide(u, (ficlUnsigned)den);
+	qr = FICL_2UNSIGNEDQR_TO_2INTEGERQR(uqr);
+	if (signRem < 0)
+		qr.remainder = -qr.remainder;
+
+	if (signQuot < 0)
+		qr.quotient = ficl2IntegerNegate(qr.quotient);
+
+	return (qr);
+}
diff --git a/usr/src/common/ficl/emu/loader_emu.c b/usr/src/common/ficl/emu/loader_emu.c
new file mode 100644
index 0000000000..c709507c78
--- /dev/null
+++ b/usr/src/common/ficl/emu/loader_emu.c
@@ -0,0 +1,1975 @@
+/*
+ * Copyright (c) 1998 Michael Smith <msmith@freebsd.org>
+ * All rights reserved.
+ *
+ * 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.
+ */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <strings.h>
+#include <limits.h>
+#include <unistd.h>
+#include <dirent.h>
+#include <macros.h>
+#include <sys/systeminfo.h>
+#include <sys/queue.h>
+#include <sys/mnttab.h>
+#include "ficl.h"
+
+/* Commands and return values; nonzero return sets command_errmsg != NULL */
+typedef int (bootblk_cmd_t)(int argc, char *argv[]);
+#define	CMD_OK		0
+#define	CMD_ERROR	1
+
+/*
+ * Support for commands
+ */
+struct bootblk_command
+{
+	const char *c_name;
+	const char *c_desc;
+	bootblk_cmd_t *c_fn;
+	STAILQ_ENTRY(bootblk_command) next;
+};
+
+#define	MDIR_REMOVED	0x0001
+#define	MDIR_NOHINTS	0x0002
+
+struct moduledir {
+	char	*d_path;	/* path of modules directory */
+	uchar_t	*d_hints;	/* content of linker.hints file */
+	int	d_hintsz;	/* size of hints data */
+	int	d_flags;
+	STAILQ_ENTRY(moduledir) d_link;
+};
+static STAILQ_HEAD(, moduledir) moduledir_list =
+    STAILQ_HEAD_INITIALIZER(moduledir_list);
+
+static const char *default_searchpath = "/platform/i86pc";
+
+static char typestr[] = "?fc?d?b? ?l?s?w";
+static int	ls_getdir(char **pathp);
+extern char **_environ;
+
+char	*command_errmsg;
+char	command_errbuf[256];
+
+extern void pager_open(void);
+extern void pager_close(void);
+extern int pager_output(const char *);
+extern int pager_file(const char *);
+static int page_file(char *);
+static int include(const char *);
+
+static int command_help(int argc, char *argv[]);
+static int command_commandlist(int argc, char *argv[]);
+static int command_show(int argc, char *argv[]);
+static int command_set(int argc, char *argv[]);
+static int command_setprop(int argc, char *argv[]);
+static int command_unset(int argc, char *argv[]);
+static int command_echo(int argc, char *argv[]);
+static int command_read(int argc, char *argv[]);
+static int command_more(int argc, char *argv[]);
+static int command_ls(int argc, char *argv[]);
+static int command_include(int argc, char *argv[]);
+static int command_autoboot(int argc, char *argv[]);
+static int command_boot(int argc, char *argv[]);
+static int command_unload(int argc, char *argv[]);
+static int command_load(int argc, char *argv[]);
+static int command_reboot(int argc, char *argv[]);
+
+#define	BF_PARSE	100
+#define	BF_DICTSIZE	30000
+
+/* update when loader version will change */
+static const char bootprog_rev[] = "1.1";
+STAILQ_HEAD(cmdh, bootblk_command) commands;
+
+/*
+ * BootForth   Interface to Ficl Forth interpreter.
+ */
+
+ficlSystem *bf_sys;
+ficlVm	*bf_vm;
+ficlWord *pInterp;
+
+/*
+ * 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.
+ *
+ * Jordan K. Hubbard
+ * 29 August 1998
+ *
+ * The meat of the simple parser.
+ */
+
+static void	 clean(void);
+static int	 insert(int *argcp, char *buf);
+
+#define	PARSE_BUFSIZE	1024	/* maximum size of one element */
+#define	MAXARGS		20	/* maximum number of elements */
+static	char		*args[MAXARGS];
+
+#define	DIGIT(x)	\
+	(isdigit(x) ? (x) - '0' : islower(x) ? (x) + 10 - 'a' : (x) + 10 - 'A')
+
+/*
+ * backslash: Return malloc'd copy of str with all standard "backslash
+ * processing" done on it.  Original can be free'd if desired.
+ */
+char *
+backslash(char *str)
+{
+	/*
+	 * Remove backslashes from the strings. Turn \040 etc. into a single
+	 * character (we allow eight bit values). Currently NUL is not
+	 * allowed.
+	 *
+	 * Turn "\n" and "\t" into '\n' and '\t' characters. Etc.
+	 */
+	char *new_str;
+	int seenbs = 0;
+	int i = 0;
+
+	if ((new_str = strdup(str)) == NULL)
+		return (NULL);
+
+	while (*str) {
+		if (seenbs) {
+			seenbs = 0;
+			switch (*str) {
+			case '\\':
+				new_str[i++] = '\\';
+				str++;
+			break;
+
+			/* preserve backslashed quotes, dollar signs */
+			case '\'':
+			case '"':
+			case '$':
+				new_str[i++] = '\\';
+				new_str[i++] = *str++;
+			break;
+
+			case 'b':
+				new_str[i++] = '\b';
+				str++;
+			break;
+
+			case 'f':
+				new_str[i++] = '\f';
+				str++;
+			break;
+
+			case 'r':
+				new_str[i++] = '\r';
+				str++;
+			break;
+
+			case 'n':
+				new_str[i++] = '\n';
+				str++;
+			break;
+
+			case 's':
+				new_str[i++] = ' ';
+				str++;
+			break;
+
+			case 't':
+				new_str[i++] = '\t';
+				str++;
+			break;
+
+			case 'v':
+				new_str[i++] = '\13';
+				str++;
+			break;
+
+			case 'z':
+				str++;
+			break;
+
+			case '0': case '1': case '2': case '3': case '4':
+			case '5': case '6': case '7': case '8': case '9': {
+				char val;
+
+				/* Three digit octal constant? */
+				if (*str >= '0' && *str <= '3' &&
+				    *(str + 1) >= '0' && *(str + 1) <= '7' &&
+				    *(str + 2) >= '0' && *(str + 2) <= '7') {
+
+					val = (DIGIT(*str) << 6) +
+					    (DIGIT(*(str + 1)) << 3) +
+					    DIGIT(*(str + 2));
+
+					/*
+					 * Allow null value if user really
+					 * wants to shoot at feet, but beware!
+					 */
+					new_str[i++] = val;
+					str += 3;
+					break;
+				}
+
+				/*
+				 * One or two digit hex constant?
+				 * If two are there they will both be taken.
+				 * Use \z to split them up if this is not
+				 * wanted.
+				 */
+				if (*str == '0' &&
+				    (*(str + 1) == 'x' || *(str + 1) == 'X') &&
+				    isxdigit(*(str + 2))) {
+					val = DIGIT(*(str + 2));
+					if (isxdigit(*(str + 3))) {
+						val = (val << 4) +
+						    DIGIT(*(str + 3));
+						str += 4;
+					} else
+						str += 3;
+					/* Yep, allow null value here too */
+					new_str[i++] = val;
+					break;
+				}
+			}
+			break;
+
+			default:
+				new_str[i++] = *str++;
+			break;
+			}
+		} else {
+			if (*str == '\\') {
+				seenbs = 1;
+				str++;
+			} else
+				new_str[i++] = *str++;
+		}
+	}
+
+	if (seenbs) {
+		/*
+		 * The final character was a '\'.
+		 * Put it in as a single backslash.
+		 */
+		new_str[i++] = '\\';
+	}
+	new_str[i] = '\0';
+	return (new_str);
+}
+
+/*
+ * parse: accept a string of input and "parse" it for backslash
+ * substitutions and environment variable expansions (${var}),
+ * returning an argc/argv style vector of whitespace separated
+ * arguments.  Returns 0 on success, 1 on failure (ok, ok, so I
+ * wimped-out on the error codes! :).
+ *
+ * Note that the argv array returned must be freed by the caller, but
+ * we own the space allocated for arguments and will free that on next
+ * invocation.  This allows argv consumers to modify the array if
+ * required.
+ *
+ * NB: environment variables that expand to more than one whitespace
+ * separated token will be returned as a single argv[] element, not
+ * split in turn.  Expanded text is also immune to further backslash
+ * elimination or expansion since this is a one-pass, non-recursive
+ * parser.  You didn't specify more than this so if you want more, ask
+ * me. - jkh
+ */
+
+#define	PARSE_FAIL(expr)	\
+if (expr) { \
+    printf("fail at line %d\n", __LINE__); \
+    clean(); \
+    free(copy); \
+    free(buf); \
+    return (1); \
+}
+
+/* Accept the usual delimiters for a variable, returning counterpart */
+static char
+isdelim(int ch)
+{
+	if (ch == '{')
+		return ('}');
+	else if (ch == '(')
+		return (')');
+	return ('\0');
+}
+
+static int
+isquote(int ch)
+{
+	return (ch == '\'');
+}
+
+static int
+isdquote(int ch)
+{
+	return (ch == '"');
+}
+
+int
+parse(int *argc, char ***argv, char *str)
+{
+	int ac;
+	char *val, *p, *q, *copy = NULL;
+	size_t i = 0;
+	char token, tmp, quote, dquote, *buf;
+	enum { STR, VAR, WHITE } state;
+
+	ac = *argc = 0;
+	dquote = quote = 0;
+	if (!str || (p = copy = backslash(str)) == NULL)
+		return (1);
+
+	/* Initialize vector and state */
+	clean();
+	state = STR;
+	buf = (char *)malloc(PARSE_BUFSIZE);
+	token = 0;
+
+	/* And awaaaaaaaaay we go! */
+	while (*p) {
+		switch (state) {
+		case STR:
+			if ((*p == '\\') && p[1]) {
+				p++;
+				PARSE_FAIL(i == (PARSE_BUFSIZE - 1));
+				buf[i++] = *p++;
+			} else if (isquote(*p)) {
+				quote = quote ? 0 : *p;
+				if (dquote) { /* keep quote */
+					PARSE_FAIL(i == (PARSE_BUFSIZE - 1));
+					buf[i++] = *p++;
+				} else
+					++p;
+			} else if (isdquote(*p)) {
+				dquote = dquote ? 0 : *p;
+				if (quote) { /* keep dquote */
+					PARSE_FAIL(i == (PARSE_BUFSIZE - 1));
+					buf[i++] = *p++;
+				} else
+					++p;
+			} else if (isspace(*p) && !quote && !dquote) {
+				state = WHITE;
+				if (i) {
+					buf[i] = '\0';
+					PARSE_FAIL(insert(&ac, buf));
+					i = 0;
+				}
+				++p;
+			} else if (*p == '$' && !quote) {
+				token = isdelim(*(p + 1));
+				if (token)
+					p += 2;
+				else
+					++p;
+				state = VAR;
+			} else {
+				PARSE_FAIL(i == (PARSE_BUFSIZE - 1));
+				buf[i++] = *p++;
+			}
+		break;
+
+		case WHITE:
+			if (isspace(*p))
+				++p;
+			else
+				state = STR;
+		break;
+
+		case VAR:
+			if (token) {
+				PARSE_FAIL((q = strchr(p, token)) == NULL);
+			} else {
+				q = p;
+				while (*q && !isspace(*q))
+				++q;
+			}
+			tmp = *q;
+			*q = '\0';
+			if ((val = getenv(p)) != NULL) {
+				size_t len = strlen(val);
+
+				strncpy(buf + i, val, PARSE_BUFSIZE - (i + 1));
+				i += min(len, PARSE_BUFSIZE - 1);
+			}
+			*q = tmp;	/* restore value */
+			p = q + (token ? 1 : 0);
+			state = STR;
+		break;
+		}
+	}
+	/* missing terminating ' or " */
+	PARSE_FAIL(quote || dquote);
+	/* If at end of token, add it */
+	if (i && state == STR) {
+		buf[i] = '\0';
+		PARSE_FAIL(insert(&ac, buf));
+	}
+	args[ac] = NULL;
+	*argc = ac;
+	*argv = (char **)malloc((sizeof (char *) * ac + 1));
+	bcopy(args, *argv, sizeof (char *) * ac + 1);
+	free(buf);
+	free(copy);
+	return (0);
+}
+
+#define	MAXARGS	20
+
+/* Clean vector space */
+static void
+clean(void)
+{
+	int i;
+
+	for (i = 0; i < MAXARGS; i++) {
+		if (args[i] != NULL) {
+			free(args[i]);
+			args[i] = NULL;
+		}
+	}
+}
+
+static int
+insert(int *argcp, char *buf)
+{
+	if (*argcp >= MAXARGS)
+		return (1);
+	args[(*argcp)++] = strdup(buf);
+	return (0);
+}
+
+static char *
+isadir(void)
+{
+	char *buf;
+	size_t bufsize = 20;
+	int ret;
+
+	if ((buf = malloc(bufsize)) == NULL)
+		return (NULL);
+	ret = sysinfo(SI_ARCHITECTURE_K, buf, bufsize);
+	if (ret == -1) {
+		free(buf);
+		return (NULL);
+	}
+	return (buf);
+}
+
+/*
+ * Shim for taking commands from BF and passing them out to 'standard'
+ * argv/argc command functions.
+ */
+static void
+bf_command(ficlVm *vm)
+{
+	char *name, *line, *tail, *cp;
+	size_t len;
+	struct bootblk_command *cmdp;
+	bootblk_cmd_t *cmd;
+	int nstrings, i;
+	int argc, result;
+	char **argv;
+
+	/* Get the name of the current word */
+	name = vm->runningWord->name;
+
+	/* Find our command structure */
+	cmd = NULL;
+	STAILQ_FOREACH(cmdp, &commands, next) {
+		if ((cmdp->c_name != NULL) && strcmp(name, cmdp->c_name) == 0)
+			cmd = cmdp->c_fn;
+	}
+	if (cmd == NULL)
+		printf("callout for unknown command '%s'\n", name);
+
+	/* Check whether we have been compiled or are being interpreted */
+	if (ficlStackPopInteger(ficlVmGetDataStack(vm))) {
+		/*
+		 * Get parameters from stack, in the format:
+		 * an un ... a2 u2 a1 u1 n --
+		 * Where n is the number of strings, a/u are pairs of
+		 * address/size for strings, and they will be concatenated
+		 * in LIFO order.
+		 */
+		nstrings = ficlStackPopInteger(ficlVmGetDataStack(vm));
+		for (i = 0, len = 0; i < nstrings; i++)
+		len += ficlStackFetch(ficlVmGetDataStack(vm), i * 2).i + 1;
+		line = malloc(strlen(name) + len + 1);
+		strcpy(line, name);
+
+		if (nstrings)
+			for (i = 0; i < nstrings; i++) {
+				len = ficlStackPopInteger(
+				    ficlVmGetDataStack(vm));
+				cp = ficlStackPopPointer(
+				    ficlVmGetDataStack(vm));
+				strcat(line, " ");
+				strncat(line, cp, len);
+			}
+	} else {
+		/* Get remainder of invocation */
+		tail = ficlVmGetInBuf(vm);
+		for (cp = tail, len = 0;
+		    cp != vm->tib.end && *cp != 0 && *cp != '\n'; cp++, len++)
+			;
+
+		line = malloc(strlen(name) + len + 2);
+		strcpy(line, name);
+		if (len > 0) {
+			strcat(line, " ");
+			strncat(line, tail, len);
+			ficlVmUpdateTib(vm, tail + len);
+		}
+	}
+
+	command_errmsg = command_errbuf;
+	command_errbuf[0] = 0;
+	if (!parse(&argc, &argv, line)) {
+		result = (cmd)(argc, argv);
+		free(argv);
+	} else {
+		result = BF_PARSE;
+	}
+	free(line);
+	/*
+	 * If there was error during nested ficlExec(), we may no longer have
+	 * valid environment to return.  Throw all exceptions from here.
+	 */
+	if (result != 0)
+		ficlVmThrow(vm, result);
+	/* This is going to be thrown!!! */
+	ficlStackPushInteger(ficlVmGetDataStack(vm), result);
+}
+
+static char *
+get_currdev(void)
+{
+	int ret;
+	char *currdev;
+	FILE *fp;
+	struct mnttab mpref = {0};
+	struct mnttab mp = {0};
+
+	mpref.mnt_mountp = "/";
+	fp = fopen(MNTTAB, "r");
+
+	/* do the best we can to return something... */
+	if (fp == NULL)
+		return (strdup(":"));
+
+	ret = getmntany(fp, &mp, &mpref);
+	(void) fclose(fp);
+	if (ret == 0)
+		(void) asprintf(&currdev, "zfs:%s:", mp.mnt_special);
+	else
+		return (strdup(":"));
+
+	return (currdev);
+}
+
+/*
+ * Replace a word definition (a builtin command) with another
+ * one that:
+ *
+ *        - Throw error results instead of returning them on the stack
+ *        - Pass a flag indicating whether the word was compiled or is
+ *          being interpreted.
+ *
+ * There is one major problem with builtins that cannot be overcome
+ * in anyway, except by outlawing it. We want builtins to behave
+ * differently depending on whether they have been compiled or they
+ * are being interpreted. Notice that this is *not* the interpreter's
+ * current state. For example:
+ *
+ * : example ls ; immediate
+ * : problem example ;		\ "ls" gets executed while compiling
+ * example			\ "ls" gets executed while interpreting
+ *
+ * Notice that, though the current state is different in the two
+ * invocations of "example", in both cases "ls" has been
+ * *compiled in*, which is what we really want.
+ *
+ * The problem arises when you tick the builtin. For example:
+ *
+ * : example-1 ['] ls postpone literal ; immediate
+ * : example-2 example-1 execute ; immediate
+ * : problem example-2 ;
+ * example-2
+ *
+ * We have no way, when we get EXECUTEd, of knowing what our behavior
+ * should be. Thus, our only alternative is to "outlaw" this. See RFI
+ * 0007, and ANS Forth Standard's appendix D, item 6.7 for a related
+ * problem, concerning compile semantics.
+ *
+ * The problem is compounded by the fact that "' builtin CATCH" is valid
+ * and desirable. The only solution is to create an intermediary word.
+ * For example:
+ *
+ * : my-ls ls ;
+ * : example ['] my-ls catch ;
+ *
+ * So, with the below implementation, here is a summary of the behavior
+ * of builtins:
+ *
+ * ls -l				\ "interpret" behavior, ie,
+ *					\ takes parameters from TIB
+ * : ex-1 s" -l" 1 ls ;			\ "compile" behavior, ie,
+ *					\ takes parameters from the stack
+ * : ex-2 ['] ls catch ; immediate	\ undefined behavior
+ * : ex-3 ['] ls catch ;		\ undefined behavior
+ * ex-2 ex-3				\ "interpret" behavior,
+ *					\ catch works
+ * : ex-4 ex-2 ;			\ "compile" behavior,
+ *					\ catch does not work
+ * : ex-5 ex-3 ; immediate		\ same as ex-2
+ * : ex-6 ex-3 ;			\ same as ex-3
+ * : ex-7 ['] ex-1 catch ;		\ "compile" behavior,
+ *					\ catch works
+ * : ex-8 postpone ls ;	immediate	\ same as ex-2
+ * : ex-9 postpone ls ;			\ same as ex-3
+ *
+ * As the definition below is particularly tricky, and it's side effects
+ * must be well understood by those playing with it, I'll be heavy on
+ * the comments.
+ *
+ * (if you edit this definition, pay attention to trailing spaces after
+ *  each word -- I warned you! :-) )
+ */
+#define	BUILTIN_CONSTRUCTOR \
+": builtin: "		\
+">in @ "		/* save the tib index pointer */ \
+"' "			/* get next word's xt */ \
+"swap >in ! "		/* point again to next word */ \
+"create "		/* create a new definition of the next word */ \
+", "			/* save previous definition's xt */ \
+"immediate "		/* make the new definition an immediate word */ \
+			\
+"does> "		/* Now, the *new* definition will: */ \
+"state @ if "		/* if in compiling state: */ \
+"1 postpone literal "	/* pass 1 flag to indicate compile */ \
+"@ compile, "		/* compile in previous definition */ \
+"postpone throw "		/* throw stack-returned result */ \
+"else "		/* if in interpreting state: */ \
+"0 swap "			/* pass 0 flag to indicate interpret */ \
+"@ execute "		/* call previous definition */ \
+"throw "			/* throw stack-returned result */ \
+"then ; "
+
+extern int ficlExecFD(ficlVm *, int);
+#define	COMMAND_SET(ptr, name, desc, fn)		\
+	ptr = malloc(sizeof (struct bootblk_command));	\
+	ptr->c_name = (name);				\
+	ptr->c_desc = (desc);				\
+	ptr->c_fn = (fn);
+
+/*
+ * Initialise the Forth interpreter, create all our commands as words.
+ */
+ficlVm *
+bf_init(const char *rc, ficlOutputFunction out)
+{
+	struct bootblk_command *cmdp;
+	char create_buf[41];	/* 31 characters-long builtins */
+	char *buf;
+	int fd, rv;
+	ficlSystemInformation *fsi;
+	ficlDictionary *dict;
+	ficlDictionary *env;
+
+	/* set up commands list */
+	STAILQ_INIT(&commands);
+	COMMAND_SET(cmdp, "help", "detailed help", command_help);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "?", "list commands", command_commandlist);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "show", "show variable(s)", command_show);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "printenv", "show variable(s)", command_show);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "set", "set a variable", command_set);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "setprop", "set a variable", command_setprop);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "unset", "unset a variable", command_unset);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "echo", "echo arguments", command_echo);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "read", "read input from the terminal", command_read);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "more", "show contents of a file", command_more);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "ls", "list files", command_ls);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "include", "read commands from a file",
+	    command_include);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "boot", "boot a file or loaded kernel", command_boot);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "autoboot", "boot automatically after a delay",
+	    command_autoboot);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "load", "load a kernel or module", command_load);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "unload", "unload all modules", command_unload);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+	COMMAND_SET(cmdp, "reboot", "reboot the system", command_reboot);
+	STAILQ_INSERT_TAIL(&commands, cmdp, next);
+
+	fsi = malloc(sizeof (ficlSystemInformation));
+	ficlSystemInformationInitialize(fsi);
+	fsi->textOut = out;
+	fsi->dictionarySize = BF_DICTSIZE;
+
+	bf_sys = ficlSystemCreate(fsi);
+	free(fsi);
+	ficlSystemCompileExtras(bf_sys);
+	bf_vm = ficlSystemCreateVm(bf_sys);
+
+	buf = isadir();
+	if (buf == NULL || strcmp(buf, "amd64") != 0) {
+		(void) setenv("ISADIR", "", 1);
+	} else {
+		(void) setenv("ISADIR", buf, 1);
+	}
+	if (buf != NULL)
+		free(buf);
+	buf = get_currdev();
+	(void) setenv("currdev", buf, 1);
+	free(buf);
+
+	/* Put all private definitions in a "builtins" vocabulary */
+	rv = ficlVmEvaluate(bf_vm,
+	    "vocabulary builtins also builtins definitions");
+	if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
+		printf("error interpreting forth: %d\n", rv);
+		exit(1);
+	}
+
+	/* Builtin constructor word  */
+	rv = ficlVmEvaluate(bf_vm, BUILTIN_CONSTRUCTOR);
+	if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
+		printf("error interpreting forth: %d\n", rv);
+		exit(1);
+	}
+
+	/* make all commands appear as Forth words */
+	dict = ficlSystemGetDictionary(bf_sys);
+	cmdp = NULL;
+	STAILQ_FOREACH(cmdp, &commands, next) {
+		ficlDictionaryAppendPrimitive(dict, (char *)cmdp->c_name,
+		    bf_command, FICL_WORD_DEFAULT);
+		rv = ficlVmEvaluate(bf_vm, "forth definitions builtins");
+		if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
+			printf("error interpreting forth: %d\n", rv);
+			exit(1);
+		}
+		sprintf(create_buf, "builtin: %s", cmdp->c_name);
+		rv = ficlVmEvaluate(bf_vm, create_buf);
+		if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
+			printf("error interpreting forth: %d\n", rv);
+			exit(1);
+		}
+		rv = ficlVmEvaluate(bf_vm, "builtins definitions");
+		if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
+			printf("error interpreting forth: %d\n", rv);
+			exit(1);
+		}
+	}
+	rv = ficlVmEvaluate(bf_vm, "only forth definitions");
+	if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
+		printf("error interpreting forth: %d\n", rv);
+		exit(1);
+	}
+
+	/*
+	 * Export some version numbers so that code can detect the
+	 * loader/host version
+	 */
+	env = ficlSystemGetEnvironment(bf_sys);
+	ficlDictionarySetConstant(env, "loader_version",
+	    (bootprog_rev[0] - '0') * 10 + (bootprog_rev[2] - '0'));
+
+	pInterp = ficlSystemLookup(bf_sys, "interpret");
+
+	/* try to load and run init file if present */
+	if (rc == NULL)
+		rc = "/boot/forth/boot.4th";
+	if (*rc != '\0') {
+		fd = open(rc, O_RDONLY);
+		if (fd != -1) {
+			(void) ficlExecFD(bf_vm, fd);
+			close(fd);
+		}
+	}
+
+	/* Do this again, so that interpret can be redefined. */
+	pInterp = ficlSystemLookup(bf_sys, "interpret");
+	return (bf_vm);
+}
+
+void
+bf_fini(void)
+{
+	ficlSystemDestroy(bf_sys);
+}
+
+/*
+ * Feed a line of user input to the Forth interpreter
+ */
+int
+bf_run(char *line)
+{
+	int result;
+	ficlString s;
+
+	FICL_STRING_SET_FROM_CSTRING(s, line);
+	result = ficlVmExecuteString(bf_vm, s);
+
+	switch (result) {
+	case FICL_VM_STATUS_OUT_OF_TEXT:
+	case FICL_VM_STATUS_ABORTQ:
+	case FICL_VM_STATUS_QUIT:
+	case FICL_VM_STATUS_ERROR_EXIT:
+	break;
+	case FICL_VM_STATUS_USER_EXIT:
+	break;
+	case FICL_VM_STATUS_ABORT:
+		printf("Aborted!\n");
+	break;
+	case BF_PARSE:
+		printf("Parse error!\n");
+	break;
+	default:
+		/* Hopefully, all other codes filled this buffer */
+		printf("%s\n", command_errmsg);
+	}
+
+	setenv("interpret", bf_vm->state ? "" : "ok", 1);
+
+	return (result);
+}
+
+char *
+get_dev(const char *path)
+{
+	FILE *fp;
+	struct mnttab mpref = {0};
+	struct mnttab mp = {0};
+	char *currdev;
+	int ret;
+	char *buf;
+	char *tmppath;
+	char *tmpdev;
+	char *cwd = NULL;
+
+	fp = fopen(MNTTAB, "r");
+
+	/* do the best we can to return something... */
+	if (fp == NULL)
+		return (strdup(path));
+
+	/*
+	 * the path can have device provided, check for it
+	 * and extract it.
+	 */
+	buf = strrchr(path, ':');
+	if (buf != NULL) {
+		tmppath = buf+1;		/* real path */
+		buf = strchr(path, ':');	/* skip zfs: */
+		buf++;
+		tmpdev = strdup(buf);
+		buf = strchr(tmpdev, ':');	/* get ending : */
+		*buf = '\0';
+	} else {
+		tmppath = (char *)path;
+		if (tmppath[0] != '/')
+			if ((cwd = getcwd(NULL, PATH_MAX)) == NULL) {
+				(void) fclose(fp);
+				return (strdup(path));
+			}
+
+		currdev = getenv("currdev");
+		buf = strchr(currdev, ':');	/* skip zfs: */
+		if (buf == NULL) {
+			(void) fclose(fp);
+			return (strdup(path));
+		}
+		buf++;
+		tmpdev = strdup(buf);
+		buf = strchr(tmpdev, ':');	/* get ending : */
+		*buf = '\0';
+	}
+
+	mpref.mnt_special = tmpdev;
+	ret = getmntany(fp, &mp, &mpref);
+	(void) fclose(fp);
+	free(tmpdev);
+
+	if (cwd == NULL)
+		(void) asprintf(&buf, "%s/%s", ret? "":mp.mnt_mountp, tmppath);
+	else {
+		(void) asprintf(&buf, "%s/%s/%s", ret? "":mp.mnt_mountp, cwd,
+		    tmppath);
+		free(cwd);
+	}
+	return (buf);
+}
+
+static void
+ngets(char *buf, int n)
+{
+	int c;
+	char *lp;
+
+	for (lp = buf; ; )
+		switch (c = getchar() & 0177) {
+		case '\n':
+		case '\r':
+			*lp = '\0';
+			putchar('\n');
+		return;
+		case '\b':
+		case '\177':
+			if (lp > buf) {
+				lp--;
+				putchar('\b');
+				putchar(' ');
+				putchar('\b');
+			}
+		break;
+		case 'r'&037: {
+			char *p;
+
+			putchar('\n');
+			for (p = buf; p < lp; ++p)
+				putchar(*p);
+		break;
+		}
+		case 'u'&037:
+		case 'w'&037:
+			lp = buf;
+			putchar('\n');
+		break;
+		default:
+			if ((n < 1) || ((lp - buf) < n - 1)) {
+				*lp++ = c;
+				putchar(c);
+			}
+		}
+	/*NOTREACHED*/
+}
+
+static int
+fgetstr(char *buf, int size, int fd)
+{
+	char c;
+	int err, len;
+
+	size--;			/* leave space for terminator */
+	len = 0;
+	while (size != 0) {
+		err = read(fd, &c, sizeof (c));
+		if (err < 0)			/* read error */
+			return (-1);
+
+		if (err == 0) {	/* EOF */
+			if (len == 0)
+				return (-1);	/* nothing to read */
+			break;
+		}
+		if ((c == '\r') || (c == '\n'))	/* line terminators */
+			break;
+		*buf++ = c;			/* keep char */
+		size--;
+		len++;
+	}
+	*buf = 0;
+	return (len);
+}
+
+static char *
+unargv(int argc, char *argv[])
+{
+	size_t hlong;
+	int i;
+	char *cp;
+
+	for (i = 0, hlong = 0; i < argc; i++)
+		hlong += strlen(argv[i]) + 2;
+
+	if (hlong == 0)
+		return (NULL);
+
+	cp = malloc(hlong);
+	cp[0] = 0;
+	for (i = 0; i < argc; i++) {
+		strcat(cp, argv[i]);
+		if (i < (argc - 1))
+			strcat(cp, " ");
+	}
+
+	return (cp);
+}
+
+/*
+ * Help is read from a formatted text file.
+ *
+ * Entries in the file are formatted as:
+ * # Ttopic [Ssubtopic] Ddescription
+ * help
+ * text
+ * here
+ * #
+ *
+ * Note that for code simplicity's sake, the above format must be followed
+ * exactly.
+ *
+ * Subtopic entries must immediately follow the topic (this is used to
+ * produce the listing of subtopics).
+ *
+ * If no argument(s) are supplied by the user, the help for 'help' is displayed.
+ */
+static int
+help_getnext(int fd, char **topic, char **subtopic, char **desc)
+{
+	char line[81], *cp, *ep;
+
+	for (;;) {
+		if (fgetstr(line, 80, fd) < 0)
+			return (0);
+
+		if ((strlen(line) < 3) || (line[0] != '#') || (line[1] != ' '))
+			continue;
+
+		*topic = *subtopic = *desc = NULL;
+		cp = line + 2;
+		while ((cp != NULL) && (*cp != 0)) {
+			ep = strchr(cp, ' ');
+			if ((*cp == 'T') && (*topic == NULL)) {
+				if (ep != NULL)
+					*ep++ = 0;
+				*topic = strdup(cp + 1);
+			} else if ((*cp == 'S') && (*subtopic == NULL)) {
+				if (ep != NULL)
+					*ep++ = 0;
+				*subtopic = strdup(cp + 1);
+			} else if (*cp == 'D') {
+				*desc = strdup(cp + 1);
+				ep = NULL;
+			}
+			cp = ep;
+		}
+		if (*topic == NULL) {
+			if (*subtopic != NULL)
+				free(*subtopic);
+			if (*desc != NULL)
+				free(*desc);
+			continue;
+		}
+		return (1);
+	}
+}
+
+static int
+help_emitsummary(char *topic, char *subtopic, char *desc)
+{
+	int i;
+
+	pager_output("    ");
+	pager_output(topic);
+	i = strlen(topic);
+	if (subtopic != NULL) {
+		pager_output(" ");
+		pager_output(subtopic);
+		i += strlen(subtopic) + 1;
+	}
+	if (desc != NULL) {
+		do {
+			pager_output(" ");
+		} while (i++ < 30);
+		pager_output(desc);
+	}
+	return (pager_output("\n"));
+}
+
+static int
+command_help(int argc, char *argv[])
+{
+	char buf[81];	/* XXX buffer size? */
+	int hfd, matched, doindex;
+	char *topic, *subtopic, *t, *s, *d;
+
+	/* page the help text from our load path */
+	sprintf(buf, "/boot/loader.help");
+	if ((hfd = open(buf, O_RDONLY)) < 0) {
+		printf("Verbose help not available, "
+		    "use '?' to list commands\n");
+		return (CMD_OK);
+	}
+
+	/* pick up request from arguments */
+	topic = subtopic = NULL;
+	switch (argc) {
+	case 3:
+		subtopic = strdup(argv[2]);
+	case 2:
+		topic = strdup(argv[1]);
+	break;
+	case 1:
+		topic = strdup("help");
+	break;
+	default:
+		command_errmsg = "usage is 'help <topic> [<subtopic>]";
+		close(hfd);
+		return (CMD_ERROR);
+	}
+
+	/* magic "index" keyword */
+	doindex = strcmp(topic, "index") == 0;
+	matched = doindex;
+
+	/* Scan the helpfile looking for help matching the request */
+	pager_open();
+	while (help_getnext(hfd, &t, &s, &d)) {
+		if (doindex) {		/* dink around formatting */
+			if (help_emitsummary(t, s, d))
+				break;
+
+		} else if (strcmp(topic, t)) {
+			/* topic mismatch */
+			/* nothing more on this topic, stop scanning */
+			if (matched)
+				break;
+		} else {
+			/* topic matched */
+			matched = 1;
+			if (((subtopic == NULL) && (s == NULL)) ||
+			    ((subtopic != NULL) && (s != NULL) &&
+			    strcmp(subtopic, s) == 0)) {
+				/* exact match, print text */
+				while ((fgetstr(buf, 80, hfd) >= 0) &&
+				    (buf[0] != '#')) {
+					if (pager_output(buf))
+						break;
+					if (pager_output("\n"))
+						break;
+				}
+			} else if ((subtopic == NULL) && (s != NULL)) {
+				/* topic match, list subtopics */
+				if (help_emitsummary(t, s, d))
+					break;
+			}
+		}
+		free(t);
+		free(s);
+		free(d);
+	}
+	pager_close();
+	close(hfd);
+	if (!matched) {
+		snprintf(command_errbuf, sizeof (command_errbuf),
+		    "no help available for '%s'", topic);
+		free(topic);
+		if (subtopic)
+			free(subtopic);
+		return (CMD_ERROR);
+	}
+	free(topic);
+	if (subtopic)
+		free(subtopic);
+	return (CMD_OK);
+}
+
+static int
+command_commandlist(int argc, char *argv[])
+{
+	struct bootblk_command *cmdp;
+	int res;
+	char name[20];
+
+	res = 0;
+	pager_open();
+	res = pager_output("Available commands:\n");
+	cmdp = NULL;
+	STAILQ_FOREACH(cmdp, &commands, next) {
+		if (res)
+			break;
+		if ((cmdp->c_name != NULL) && (cmdp->c_desc != NULL)) {
+			sprintf(name, "  %-15s  ", cmdp->c_name);
+			pager_output(name);
+			pager_output(cmdp->c_desc);
+			res = pager_output("\n");
+		}
+	}
+	pager_close();
+	return (CMD_OK);
+}
+
+/*
+ * XXX set/show should become set/echo if we have variable
+ * substitution happening.
+ */
+static int
+command_show(int argc, char *argv[])
+{
+	char **ev;
+	char *cp;
+
+	if (argc < 2) {
+		/*
+		 * With no arguments, print everything.
+		 */
+		pager_open();
+		for (ev = _environ; *ev != NULL; ev++) {
+			pager_output(*ev);
+			cp = getenv(*ev);
+			if (cp != NULL) {
+				pager_output("=");
+				pager_output(cp);
+			}
+			if (pager_output("\n"))
+				break;
+		}
+		pager_close();
+	} else {
+		if ((cp = getenv(argv[1])) != NULL) {
+			printf("%s\n", cp);
+		} else {
+			snprintf(command_errbuf, sizeof (command_errbuf),
+			    "variable '%s' not found", argv[1]);
+			return (CMD_ERROR);
+		}
+	}
+	return (CMD_OK);
+}
+
+static int
+command_set(int argc, char *argv[])
+{
+	int	err;
+	char	*value, *copy;
+
+	if (argc != 2) {
+		command_errmsg = "wrong number of arguments";
+		return (CMD_ERROR);
+	} else {
+		copy = strdup(argv[1]);
+		if (copy == NULL) {
+			command_errmsg = strerror(errno);
+			return (CMD_ERROR);
+		}
+		if ((value = strchr(copy, '=')) != NULL)
+			*(value++) = 0;
+		else
+			value = "";
+		if ((err = setenv(copy, value, 1)) != 0) {
+			free(copy);
+			command_errmsg = strerror(errno);
+			return (CMD_ERROR);
+		}
+		free(copy);
+	}
+	return (CMD_OK);
+}
+
+static int
+command_setprop(int argc, char *argv[])
+{
+	int err;
+
+	if (argc != 3) {
+		command_errmsg = "wrong number of arguments";
+		return (CMD_ERROR);
+	} else {
+		if ((err = setenv(argv[1], argv[2], 1)) != 0) {
+			command_errmsg = strerror(err);
+			return (CMD_ERROR);
+		}
+	}
+	return (CMD_OK);
+}
+
+static int
+command_unset(int argc, char *argv[])
+{
+	int err;
+
+	if (argc != 2) {
+		command_errmsg = "wrong number of arguments";
+		return (CMD_ERROR);
+	} else {
+		if ((err = unsetenv(argv[1])) != 0) {
+			command_errmsg = strerror(err);
+			return (CMD_ERROR);
+		}
+	}
+	return (CMD_OK);
+}
+
+static int
+command_echo(int argc, char *argv[])
+{
+	char *s;
+	int nl, ch;
+
+	nl = 0;
+	optind = 1;
+	opterr = 1;
+	while ((ch = getopt(argc, argv, "n")) != -1) {
+		switch (ch) {
+		case 'n':
+			nl = 1;
+		break;
+		case '?':
+		default:
+			/* getopt has already reported an error */
+		return (CMD_OK);
+		}
+	}
+	argv += (optind);
+	argc -= (optind);
+
+	s = unargv(argc, argv);
+	if (s != NULL) {
+		printf("%s", s);
+		free(s);
+	}
+	if (!nl)
+		printf("\n");
+	return (CMD_OK);
+}
+
+/*
+ * A passable emulation of the sh(1) command of the same name.
+ */
+static int
+ischar(void)
+{
+	return (1);
+}
+
+static int
+command_read(int argc, char *argv[])
+{
+	char *prompt;
+	int timeout;
+	time_t when;
+	char *cp;
+	char *name;
+	char buf[256];		/* XXX size? */
+	int c;
+
+	timeout = -1;
+	prompt = NULL;
+	optind = 1;
+	opterr = 1;
+	while ((c = getopt(argc, argv, "p:t:")) != -1) {
+		switch (c) {
+		case 'p':
+			prompt = optarg;
+		break;
+		case 't':
+			timeout = strtol(optarg, &cp, 0);
+			if (cp == optarg) {
+				snprintf(command_errbuf,
+				    sizeof (command_errbuf),
+				    "bad timeout '%s'", optarg);
+				return (CMD_ERROR);
+			}
+		break;
+		default:
+		return (CMD_OK);
+		}
+	}
+
+	argv += (optind);
+	argc -= (optind);
+	name = (argc > 0) ? argv[0]: NULL;
+
+	if (prompt != NULL)
+		printf("%s", prompt);
+	if (timeout >= 0) {
+		when = time(NULL) + timeout;
+		while (!ischar())
+			if (time(NULL) >= when)
+				return (CMD_OK); /* is timeout an error? */
+	}
+
+	ngets(buf, sizeof (buf));
+
+	if (name != NULL)
+		setenv(name, buf, 1);
+	return (CMD_OK);
+}
+
+/*
+ * File pager
+ */
+static int
+command_more(int argc, char *argv[])
+{
+	int i;
+	int res;
+	char line[80];
+	char *name;
+
+	res = 0;
+	pager_open();
+	for (i = 1; (i < argc) && (res == 0); i++) {
+		sprintf(line, "*** FILE %s BEGIN ***\n", argv[i]);
+		if (pager_output(line))
+			break;
+		name = get_dev(argv[i]);
+		res = page_file(name);
+		free(name);
+		if (!res) {
+			sprintf(line, "*** FILE %s END ***\n", argv[i]);
+			res = pager_output(line);
+		}
+	}
+	pager_close();
+
+	if (res == 0)
+		return (CMD_OK);
+	return (CMD_ERROR);
+}
+
+static int
+page_file(char *filename)
+{
+	int result;
+
+	result = pager_file(filename);
+
+	if (result == -1) {
+		snprintf(command_errbuf, sizeof (command_errbuf),
+		    "error showing %s", filename);
+	}
+
+	return (result);
+}
+
+static int
+command_ls(int argc, char *argv[])
+{
+	DIR *dir;
+	int fd;
+	struct stat sb;
+	struct dirent *d;
+	char *buf, *path;
+	char lbuf[128];	/* one line */
+	int result, ch;
+	int verbose;
+
+	result = CMD_OK;
+	fd = -1;
+	verbose = 0;
+	optind = 1;
+	opterr = 1;
+	while ((ch = getopt(argc, argv, "l")) != -1) {
+		switch (ch) {
+		case 'l':
+			verbose = 1;
+		break;
+		case '?':
+		default:
+			/* getopt has already reported an error */
+		return (CMD_OK);
+		}
+	}
+	argv += (optind - 1);
+	argc -= (optind - 1);
+
+	if (argc < 2) {
+		path = "";
+	} else {
+		path = argv[1];
+	}
+
+	fd = ls_getdir(&path);
+	if (fd == -1) {
+		result = CMD_ERROR;
+		goto out;
+	}
+	dir = fdopendir(fd);
+	pager_open();
+	pager_output(path);
+	pager_output("\n");
+
+	while ((d = readdir(dir)) != NULL) {
+		if (strcmp(d->d_name, ".") && strcmp(d->d_name, "..")) {
+			/* stat the file, if possible */
+			sb.st_size = 0;
+			sb.st_mode = 0;
+			buf = malloc(strlen(path) + strlen(d->d_name) + 2);
+			if (path[0] == '\0')
+				sprintf(buf, "%s", d->d_name);
+			else
+				sprintf(buf, "%s/%s", path, d->d_name);
+			/* ignore return, could be symlink, etc. */
+			if (stat(buf, &sb))
+				sb.st_size = 0;
+			free(buf);
+			if (verbose) {
+				sprintf(lbuf, " %c %8d %s\n",
+				    typestr[sb.st_mode >> 12],
+				    (int)sb.st_size, d->d_name);
+			} else {
+				sprintf(lbuf, " %c  %s\n",
+				    typestr[sb.st_mode >> 12], d->d_name);
+			}
+			if (pager_output(lbuf))
+				goto out;
+		}
+	}
+out:
+	pager_close();
+	if (fd != -1)
+		closedir(dir);
+	if (path != NULL)
+		free(path);
+	return (result);
+}
+
+/*
+ * Given (path) containing a vaguely reasonable path specification, return an fd
+ * on the directory, and an allocated copy of the path to the directory.
+ */
+static int
+ls_getdir(char **pathp)
+{
+	struct stat sb;
+	int fd;
+	char *cp, *path;
+
+	fd = -1;
+
+	/* one extra byte for a possible trailing slash required */
+	path = malloc(strlen(*pathp) + 2);
+	strcpy(path, *pathp);
+
+	/* Make sure the path is respectable to begin with */
+	if ((cp = get_dev(path)) == NULL) {
+		snprintf(command_errbuf, sizeof (command_errbuf),
+		    "bad path '%s'", path);
+		goto out;
+	}
+
+	/* If there's no path on the device, assume '/' */
+	if (*cp == 0)
+		strcat(path, "/");
+
+	fd = open(cp, O_RDONLY);
+	if (fd < 0) {
+		snprintf(command_errbuf, sizeof (command_errbuf),
+		    "open '%s' failed: %s", path, strerror(errno));
+		goto out;
+	}
+	if (fstat(fd, &sb) < 0) {
+		snprintf(command_errbuf, sizeof (command_errbuf),
+		    "stat failed: %s", strerror(errno));
+		goto out;
+	}
+	if (!S_ISDIR(sb.st_mode)) {
+		snprintf(command_errbuf, sizeof (command_errbuf),
+		    "%s: %s", path, strerror(ENOTDIR));
+		goto out;
+	}
+
+	free(cp);
+	*pathp = path;
+	return (fd);
+
+out:
+	free(cp);
+	free(path);
+	*pathp = NULL;
+	if (fd != -1)
+		close(fd);
+	return (-1);
+}
+
+static int
+command_include(int argc, char *argv[])
+{
+	int i;
+	int res;
+	char **argvbuf;
+
+	/*
+	 * Since argv is static, we need to save it here.
+	 */
+	argvbuf = (char **)calloc(argc, sizeof (char *));
+	for (i = 0; i < argc; i++)
+		argvbuf[i] = strdup(argv[i]);
+
+	res = CMD_OK;
+	for (i = 1; (i < argc) && (res == CMD_OK); i++)
+		res = include(argvbuf[i]);
+
+	for (i = 0; i < argc; i++)
+		free(argvbuf[i]);
+	free(argvbuf);
+
+	return (res);
+}
+
+/*
+ * Header prepended to each line. The text immediately follows the header.
+ * We try to make this short in order to save memory -- the loader has
+ * limited memory available, and some of the forth files are very long.
+ */
+struct includeline
+{
+	struct includeline *next;
+	int line;
+	char text[];
+};
+
+int
+include(const char *filename)
+{
+	struct includeline *script, *se, *sp;
+	int res = CMD_OK;
+	int prevsrcid, fd, line;
+	char *cp, input[256]; /* big enough? */
+	char *path;
+
+	path = get_dev(filename);
+	if (((fd = open(path, O_RDONLY)) == -1)) {
+		snprintf(command_errbuf, sizeof (command_errbuf),
+		    "can't open '%s': %s", filename,
+		    strerror(errno));
+		free(path);
+		return (CMD_ERROR);
+	}
+
+	free(path);
+	/*
+	 * Read the script into memory.
+	 */
+	script = se = NULL;
+	line = 0;
+
+	while (fgetstr(input, sizeof (input), fd) >= 0) {
+		line++;
+		cp = input;
+		/* Allocate script line structure and copy line, flags */
+		if (*cp == '\0')
+			continue;	/* ignore empty line, save memory */
+		if (cp[0] == '\\' && cp[1] == ' ')
+			continue;	/* ignore comment */
+
+		sp = malloc(sizeof (struct includeline) + strlen(cp) + 1);
+		/*
+		 * On malloc failure (it happens!), free as much as possible
+		 * and exit
+		 */
+		if (sp == NULL) {
+			while (script != NULL) {
+				se = script;
+				script = script->next;
+				free(se);
+			}
+			snprintf(command_errbuf, sizeof (command_errbuf),
+			    "file '%s' line %d: memory allocation "
+			    "failure - aborting", filename, line);
+			return (CMD_ERROR);
+		}
+		strcpy(sp->text, cp);
+		sp->line = line;
+		sp->next = NULL;
+
+		if (script == NULL) {
+			script = sp;
+		} else {
+			se->next = sp;
+		}
+		se = sp;
+	}
+	close(fd);
+
+	/*
+	 * Execute the script
+	 */
+
+	prevsrcid = bf_vm->sourceId.i;
+	bf_vm->sourceId.i = fd+1;	/* 0 is user input device */
+
+	res = CMD_OK;
+
+	for (sp = script; sp != NULL; sp = sp->next) {
+		res = bf_run(sp->text);
+		if (res != FICL_VM_STATUS_OUT_OF_TEXT) {
+			snprintf(command_errbuf, sizeof (command_errbuf),
+			    "Error while including %s, in the line %d:\n%s",
+			    filename, sp->line, sp->text);
+			res = CMD_ERROR;
+			break;
+		} else
+			res = CMD_OK;
+	}
+
+	bf_vm->sourceId.i = -1;
+	(void) bf_run("");
+	bf_vm->sourceId.i = prevsrcid;
+
+	while (script != NULL) {
+		se = script;
+		script = script->next;
+		free(se);
+	}
+
+	return (res);
+}
+
+static int
+command_boot(int argc, char *argv[])
+{
+	return (CMD_OK);
+}
+
+static int
+command_autoboot(int argc, char *argv[])
+{
+	return (CMD_OK);
+}
+
+static void
+moduledir_rebuild(void)
+{
+	struct moduledir *mdp, *mtmp;
+	const char *path, *cp, *ep;
+	int cplen;
+
+	path = getenv("module_path");
+	if (path == NULL)
+		path = default_searchpath;
+	/*
+	 * Rebuild list of module directories if it changed
+	 */
+	STAILQ_FOREACH(mdp, &moduledir_list, d_link)
+		mdp->d_flags |= MDIR_REMOVED;
+
+	for (ep = path; *ep != 0;  ep++) {
+		cp = ep;
+		for (; *ep != 0 && *ep != ';'; ep++)
+			;
+		/*
+		 * Ignore trailing slashes
+		 */
+		for (cplen = ep - cp; cplen > 1 && cp[cplen - 1] == '/';
+		    cplen--)
+			;
+		STAILQ_FOREACH(mdp, &moduledir_list, d_link) {
+			if (strlen(mdp->d_path) != cplen ||
+			    bcmp(cp, mdp->d_path, cplen) != 0)
+				continue;
+			mdp->d_flags &= ~MDIR_REMOVED;
+			break;
+		}
+		if (mdp == NULL) {
+			mdp = malloc(sizeof (*mdp) + cplen + 1);
+			if (mdp == NULL)
+				return;
+			mdp->d_path = (char *)(mdp + 1);
+			bcopy(cp, mdp->d_path, cplen);
+			mdp->d_path[cplen] = 0;
+			mdp->d_hints = NULL;
+			mdp->d_flags = 0;
+			STAILQ_INSERT_TAIL(&moduledir_list, mdp, d_link);
+		}
+		if (*ep == 0)
+			break;
+	}
+	/*
+	 * Delete unused directories if any
+	 */
+	mdp = STAILQ_FIRST(&moduledir_list);
+	while (mdp) {
+		if ((mdp->d_flags & MDIR_REMOVED) == 0) {
+			mdp = STAILQ_NEXT(mdp, d_link);
+		} else {
+			if (mdp->d_hints)
+				free(mdp->d_hints);
+			mtmp = mdp;
+			mdp = STAILQ_NEXT(mdp, d_link);
+			STAILQ_REMOVE(&moduledir_list, mtmp, moduledir, d_link);
+			free(mtmp);
+		}
+	}
+}
+
+static char *
+file_lookup(const char *path, const char *name, int namelen)
+{
+	struct stat st;
+	char *result, *cp, *gz;
+	int pathlen;
+
+	pathlen = strlen(path);
+	result = malloc(pathlen + namelen + 2);
+	if (result == NULL)
+		return (NULL);
+	bcopy(path, result, pathlen);
+	if (pathlen > 0 && result[pathlen - 1] != '/')
+		result[pathlen++] = '/';
+	cp = result + pathlen;
+	bcopy(name, cp, namelen);
+	cp += namelen;
+	*cp = '\0';
+	if (stat(result, &st) == 0 && S_ISREG(st.st_mode))
+		return (result);
+	/* also check for gz file */
+	(void) asprintf(&gz, "%s.gz", result);
+	if (gz != NULL) {
+		int res = stat(gz, &st);
+		free(gz);
+		if (res == 0)
+			return (result);
+	}
+	free(result);
+	return (NULL);
+}
+
+static char *
+file_search(const char *name)
+{
+	struct moduledir *mdp;
+	struct stat sb;
+	char *result;
+	int namelen;
+
+	if (name == NULL)
+		return (NULL);
+	if (*name == 0)
+		return (strdup(name));
+
+	if (strchr(name, '/') != NULL) {
+		char *gz;
+		if (stat(name, &sb) == 0)
+			return (strdup(name));
+		/* also check for gz file */
+		(void) asprintf(&gz, "%s.gz", name);
+		if (gz != NULL) {
+			int res = stat(gz, &sb);
+			free(gz);
+			if (res == 0)
+				return (strdup(name));
+		}
+		return (NULL);
+	}
+
+	moduledir_rebuild();
+	result = NULL;
+	namelen = strlen(name);
+	STAILQ_FOREACH(mdp, &moduledir_list, d_link) {
+		result = file_lookup(mdp->d_path, name, namelen);
+		if (result)
+			break;
+	}
+	return (result);
+}
+
+static int
+command_load(int argc, char *argv[])
+{
+	int dofile, ch;
+	char *typestr = NULL;
+	char *filename;
+	dofile = 0;
+	optind = 1;
+
+	if (argc == 1) {
+		command_errmsg = "no filename specified";
+		return (CMD_ERROR);
+	}
+
+	while ((ch = getopt(argc, argv, "kt:")) != -1) {
+		switch (ch) {
+		case 'k':
+			break;
+		case 't':
+			typestr = optarg;
+			dofile = 1;
+			break;
+		case '?':
+		default:
+			return (CMD_OK);
+		}
+	}
+	argv += (optind - 1);
+	argc -= (optind - 1);
+	if (dofile) {
+		if ((typestr == NULL) || (*typestr == 0)) {
+			command_errmsg = "invalid load type";
+			return (CMD_ERROR);
+		}
+#if 0
+		return (file_loadraw(argv[1], typestr, argc - 2, argv + 2, 1)
+		    ? CMD_OK : CMD_ERROR);
+#endif
+		return (CMD_OK);
+	}
+
+	filename = file_search(argv[1]);
+	if (filename == NULL) {
+		snprintf(command_errbuf, sizeof (command_errbuf),
+		    "can't find '%s'", argv[1]);
+		return (CMD_ERROR);
+	}
+	setenv("kernelname", filename, 1);
+
+	return (CMD_OK);
+}
+
+static int
+command_unload(int argc, char *argv[])
+{
+	unsetenv("kernelname");
+	return (CMD_OK);
+}
+
+static int
+command_reboot(int argc, char *argv[])
+{
+	exit(0);
+	return (CMD_OK);
+}
diff --git a/usr/src/common/ficl/emu/loader_emu.h b/usr/src/common/ficl/emu/loader_emu.h
new file mode 100644
index 0000000000..7cbdff886e
--- /dev/null
+++ b/usr/src/common/ficl/emu/loader_emu.h
@@ -0,0 +1,49 @@
+/*
+ * This file and its contents are supplied under the terms of the
+ * Common Development and Distribution License ("CDDL"), version 1.0.
+ * You may only use this file in accordance with the terms of version
+ * 1.0 of the CDDL.
+ *
+ * A full copy of the text of the CDDL should have accompanied this
+ * source.  A copy of the CDDL is also available via the Internet at
+ * http://www.illumos.org/license/CDDL.
+ */
+
+/*
+ * Copyright 2015 Toomas Soome <tsoome@me.com>
+ */
+
+#ifndef _LOADER_EMU_H
+#define	_LOADER_EMU_H
+
+/*
+ * BootFORTH emulator interface.
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* Commands and return values; nonzero return sets command_errmsg != NULL */
+typedef int (bootblk_cmd_t)(int argc, char *argv[]);
+extern char *command_errmsg;
+extern char command_errbuf[];	/* XXX blah, length */
+#define	CMD_OK		0
+#define	CMD_ERROR	1
+
+/*
+ * Support for commands
+ */
+struct bootblk_command
+{
+	const char	*c_name;
+	const char	*c_desc;
+	bootblk_cmd_t	*c_fn;
+	STAILQ_ENTRY(bootblk_command) next;
+};
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _LOADER_EMU_H */
diff --git a/usr/src/common/ficl/extras.c b/usr/src/common/ficl/extras.c
new file mode 100644
index 0000000000..431a898ce1
--- /dev/null
+++ b/usr/src/common/ficl/extras.c
@@ -0,0 +1,184 @@
+#include "ficl.h"
+#include <unistd.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+/*
+ * Ficl interface to system (ANSI)
+ * Gets a newline (or NULL) delimited string from the input
+ * and feeds it to the ANSI system function...
+ * Example:
+ *    system del *.*
+ *    \ ouch!
+ */
+static void
+ficlPrimitiveSystem(ficlVm *vm)
+{
+	ficlCountedString *counted = (ficlCountedString *)vm->pad;
+
+	ficlVmGetString(vm, counted, '\n');
+	if (FICL_COUNTED_STRING_GET_LENGTH(*counted) > 0) {
+		int returnValue = \
+		    system(FICL_COUNTED_STRING_GET_POINTER(*counted));
+		if (returnValue) {
+			sprintf(vm->pad, "System call returned %d\n",
+			    returnValue);
+			ficlVmTextOut(vm, vm->pad);
+			ficlVmThrow(vm, FICL_VM_STATUS_QUIT);
+		}
+	} else {
+		ficlVmTextOut(vm, "Warning (system): nothing happened\n");
+	}
+}
+
+/*
+ * Ficl add-in to load a text file and execute it...
+ * Cheesy, but illustrative.
+ * Line oriented... filename is newline (or NULL) delimited.
+ * Example:
+ *    load test.f
+ */
+#define	BUFFER_SIZE	256
+static void
+ficlPrimitiveLoad(ficlVm *vm)
+{
+	char buffer[BUFFER_SIZE];
+	char filename[BUFFER_SIZE];
+	ficlCountedString *counted = (ficlCountedString *)filename;
+	int line = 0;
+	FILE *f;
+	int result = 0;
+	ficlCell oldSourceId;
+	ficlString s;
+
+	ficlVmGetString(vm, counted, '\n');
+
+	if (FICL_COUNTED_STRING_GET_LENGTH(*counted) <= 0) {
+		ficlVmTextOut(vm, "Warning (load): nothing happened\n");
+		return;
+	}
+
+	/*
+	 * get the file's size and make sure it exists
+	 */
+
+	f = fopen(FICL_COUNTED_STRING_GET_POINTER(*counted), "r");
+	if (!f) {
+		ficlVmTextOut(vm, "Unable to open file ");
+		ficlVmTextOut(vm, FICL_COUNTED_STRING_GET_POINTER(*counted));
+		ficlVmTextOut(vm, "\n");
+		ficlVmThrow(vm, FICL_VM_STATUS_QUIT);
+	}
+
+	oldSourceId = vm->sourceId;
+	vm->sourceId.p = (void *)f;
+
+	/* feed each line to ficlExec */
+	while (fgets(buffer, BUFFER_SIZE, f)) {
+		int length = strlen(buffer) - 1;
+
+		line++;
+		if (length <= 0)
+			continue;
+
+		if (buffer[length] == '\n')
+			buffer[length--] = '\0';
+
+		FICL_STRING_SET_POINTER(s, buffer);
+		FICL_STRING_SET_LENGTH(s, length + 1);
+		result = ficlVmExecuteString(vm, s);
+		/* handle "bye" in loaded files. --lch */
+		switch (result) {
+		case FICL_VM_STATUS_OUT_OF_TEXT:
+		case FICL_VM_STATUS_USER_EXIT:
+		break;
+
+		default:
+			vm->sourceId = oldSourceId;
+			fclose(f);
+			ficlVmThrowError(vm, "Error loading file <%s> line %d",
+			    FICL_COUNTED_STRING_GET_POINTER(*counted), line);
+		break;
+		}
+	}
+	/*
+	 * Pass an empty line with SOURCE-ID == -1 to flush
+	 * any pending REFILLs (as required by FILE wordset)
+	 */
+	vm->sourceId.i = -1;
+	FICL_STRING_SET_FROM_CSTRING(s, "");
+	ficlVmExecuteString(vm, s);
+
+	vm->sourceId = oldSourceId;
+	fclose(f);
+
+	/* handle "bye" in loaded files. --lch */
+	if (result == FICL_VM_STATUS_USER_EXIT)
+		ficlVmThrow(vm, FICL_VM_STATUS_USER_EXIT);
+}
+
+/*
+ * Dump a tab delimited file that summarizes the contents of the
+ * dictionary hash table by hashcode...
+ */
+static void
+ficlPrimitiveSpewHash(ficlVm *vm)
+{
+	ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist;
+	ficlWord *word;
+	FILE *f;
+	unsigned i;
+	unsigned hashSize = hash->size;
+
+	if (!ficlVmGetWordToPad(vm))
+		ficlVmThrow(vm, FICL_VM_STATUS_OUT_OF_TEXT);
+
+	f = fopen(vm->pad, "w");
+	if (!f) {
+		ficlVmTextOut(vm, "unable to open file\n");
+		return;
+	}
+
+	for (i = 0; i < hashSize; i++) {
+		int n = 0;
+
+		word = hash->table[i];
+		while (word) {
+			n++;
+			word = word->link;
+		}
+
+		fprintf(f, "%d\t%d", i, n);
+
+		word = hash->table[i];
+		while (word) {
+			fprintf(f, "\t%s", word->name);
+			word = word->link;
+		}
+
+		fprintf(f, "\n");
+	}
+
+	fclose(f);
+}
+
+static void
+ficlPrimitiveBreak(ficlVm *vm)
+{
+	vm->state = vm->state;
+}
+
+void
+ficlSystemCompileExtras(ficlSystem *system)
+{
+	ficlDictionary *dictionary = ficlSystemGetDictionary(system);
+
+	ficlDictionarySetPrimitive(dictionary, "break", ficlPrimitiveBreak,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "load", ficlPrimitiveLoad,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "spewhash",
+	    ficlPrimitiveSpewHash, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "system", ficlPrimitiveSystem,
+	    FICL_WORD_DEFAULT);
+}
diff --git a/usr/src/common/ficl/ficl.h b/usr/src/common/ficl/ficl.h
new file mode 100644
index 0000000000..eb43250ec8
--- /dev/null
+++ b/usr/src/common/ficl/ficl.h
@@ -0,0 +1,1799 @@
+/*
+ * f i c l . h
+ * Forth Inspired Command Language
+ * Author: John Sadler (john_sadler@alum.mit.edu)
+ * Created: 19 July 1997
+ * Dedicated to RHS, in loving memory
+ * $Id: ficl.h,v 1.25 2010/10/03 09:52:12 asau 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.
+ */
+
+#ifndef	_FICL_H
+#define	_FICL_H
+/*
+ * Ficl (Forth-inspired command language) is an ANS Forth
+ * interpreter written in C. Unlike traditional Forths, this
+ * interpreter is designed to be embedded into other systems
+ * as a command/macro/development prototype language.
+ *
+ * Where Forths usually view themselves as the center of the system
+ * and expect the rest of the system to be coded in Forth, Ficl
+ * acts as a component of the system. It is easy to export
+ * code written in C or ASM to Ficl in the style of TCL, or to invoke
+ * Ficl code from a compiled module. This allows you to do incremental
+ * development in a way that combines the best features of threaded
+ * languages (rapid development, quick code/test/debug cycle,
+ * reasonably fast) with the best features of C (everyone knows it,
+ * easier to support large blocks of code, efficient, type checking).
+ *
+ * Ficl provides facilities for interoperating
+ * with programs written in C: C functions can be exported to Ficl,
+ * and Ficl commands can be executed via a C calling interface. The
+ * interpreter is re-entrant, so it can be used in multiple instances
+ * in a multitasking system. Unlike Forth, Ficl's outer interpreter
+ * expects a text block as input, and returns to the caller after each
+ * text block, so the "data pump" is somewhere in external code. This
+ * is more like TCL than Forth, which usually expects to be at the center
+ * of the system, requesting input at its convenience. Each Ficl virtual
+ * machine can be bound to a different I/O channel, and is independent
+ * of all others in in the same address space except that all virtual
+ * machines share a common dictionary (a sort or open symbol table that
+ * defines all of the elements of the language).
+ *
+ * Code is written in ANSI C for portability.
+ *
+ * Summary of Ficl features and constraints:
+ * - Standard: Implements the ANSI Forth CORE word set and part
+ *   of the CORE EXT word-set, SEARCH and SEARCH EXT, TOOLS and
+ *   TOOLS EXT, LOCAL and LOCAL ext and various extras.
+ * - Extensible: you can export code written in Forth, C,
+ *   or asm in a straightforward way. Ficl provides open
+ *   facilities for extending the language in an application
+ *   specific way. You can even add new control structures!
+ * - Ficl and C can interact in two ways: Ficl can encapsulate
+ *   C code, or C code can invoke Ficl code.
+ * - Thread-safe, re-entrant: The shared system dictionary
+ *   uses a locking mechanism that you can either supply
+ *   or stub out to provide exclusive access. Each Ficl
+ *   virtual machine has an otherwise complete state, and
+ *   each can be bound to a separate I/O channel (or none at all).
+ * - Simple encapsulation into existing systems: a basic implementation
+ *   requires three function calls (see the example program in testmain.c).
+ * - ROMable: Ficl is designed to work in RAM-based and ROM code / RAM data
+ *   environments. It does require somewhat more memory than a pure
+ *   ROM implementation because it builds its system dictionary in
+ *   RAM at startup time.
+ * - Written an ANSI C to be as simple as I can make it to understand,
+ *   support, debug, and port. Compiles without complaint at /Az /W4
+ *   (require ANSI C, max warnings) under Microsoft VC++ 5.
+ * - Does full 32 bit math (but you need to implement
+ *   two mixed precision math primitives (see sysdep.c))
+ * - Indirect threaded interpreter is not the fastest kind of
+ *   Forth there is (see pForth 68K for a really fast subroutine
+ *   threaded interpreter), but it's the cleanest match to a
+ *   pure C implementation.
+ *
+ * P O R T I N G   F i c l
+ *
+ * To install Ficl on your target system, you need an ANSI C compiler
+ * and its runtime library. Inspect the system dependent macros and
+ * functions in sysdep.h and sysdep.c and edit them to suit your
+ * system. For example, INT16 is a short on some compilers and an
+ * int on others. Check the default CELL alignment controlled by
+ * FICL_ALIGN. If necessary, add new definitions of ficlMalloc, ficlFree,
+ * ficlLockDictionary, and ficlCallbackDefaultTextOut to work with your
+ * operating system.  Finally, use testmain.c as a guide to installing the
+ * Ficl system and one or more virtual machines into your code. You do not
+ * need to include testmain.c in your build.
+ *
+ * T o   D o   L i s t
+ *
+ * 1. Unimplemented system dependent CORE word: key
+ * 2. 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://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
+ *   http://www.taygeta.com/forth.html
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef STAND
+#include <stand.h>
+#include <sys/stdint.h>
+#else
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <string.h>
+
+extern void pager_open(void);
+extern int pager_output(const char *);
+extern void pager_close(void);
+#endif
+#include <setjmp.h>
+#include <stdarg.h>
+
+/*
+ * Put all your local defines in ficllocal.h,
+ * rather than editing the makefile/project/etc.
+ * ficllocal.h will always ship as an inert file.
+ */
+
+#include "ficllocal.h"
+#include "ficlplatform/unix.h"
+
+/*
+ *
+ * B U I L D   C O N T R O L S
+ *
+ * First, the FICL_WANT_* settings.
+ * These are all optional settings that you may or may not
+ * want Ficl to use.
+ *
+ */
+
+/*
+ * FICL_WANT_MINIMAL
+ * If set to nonzero, build the smallest possible Ficl interpreter.
+ */
+#if !defined(FICL_WANT_MINIMAL)
+#define	FICL_WANT_MINIMAL		(0)
+#endif
+
+#if FICL_WANT_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)
+#define	FICL_WANT_DEBUGGER		(0)
+#define	FICL_WANT_OOP			(0)
+#define	FICL_WANT_PLATFORM		(0)
+#define	FICL_WANT_MULTITHREADED		(0)
+#define	FICL_WANT_EXTENDED_PREFIX	(0)
+
+#define	FICL_ROBUST			(0)
+
+#endif /* FICL_WANT_MINIMAL */
+
+/*
+ * FICL_WANT_PLATFORM
+ * Includes words defined in ficlCompilePlatform
+ * (see ficlplatform/win32.c and ficlplatform/unix.c for example)
+ */
+#if !defined(FICL_WANT_PLATFORM)
+#define	FICL_WANT_PLATFORM	(1)
+#endif /* FICL_WANT_PLATFORM */
+
+/*
+ * FICL_WANT_LZ4_SOFTCORE
+ * If nonzero, the softcore words are stored compressed
+ * with patent-unencumbered LZ4 compression.
+ * This results in a smaller Ficl interpreter, and adds
+ * only a *tiny* runtime speed hit.
+ *
+ * Original LZ77 contributed by Larry Hastings.
+ * Updated to LZ4 which is even more space efficient.
+ */
+#if !defined(FICL_WANT_LZ4_SOFTCORE)
+#define	FICL_WANT_LZ4_SOFTCORE	(1)
+#endif /* FICL_WANT_LZ4_SOFTCORE */
+
+/*
+ * 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_FILE */
+
+/*
+ * FICL_WANT_FLOAT
+ * Includes a floating point stack for the VM, and words to do float operations.
+ * Contributed by Guy Carver
+ */
+#if !defined(FICL_WANT_FLOAT)
+#define	FICL_WANT_FLOAT	(1)
+#endif /* FICL_WANT_FLOAT */
+
+/*
+ * FICL_WANT_DEBUGGER
+ * Inludes a simple source level debugger
+ */
+#if !defined(FICL_WANT_DEBUGGER)
+#define	FICL_WANT_DEBUGGER	(1)
+#endif /* FICL_WANT_DEBUGGER */
+
+/*
+ * 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_WANT_EXTENDED_PREFIX)
+#define	FICL_WANT_EXTENDED_PREFIX	(1)
+#endif /* FICL_WANT_EXTENDED_PREFIX */
+
+/*
+ * FICL_WANT_USER
+ * Enables user variables: per-instance variables bound to the VM.
+ * Kind of like thread-local storage. Could be implemented in a
+ * VM private dictionary, but I've chosen the lower overhead
+ * approach of an array of CELLs instead.
+ */
+#if !defined(FICL_WANT_USER)
+#define	FICL_WANT_USER	(1)
+#endif /* FICL_WANT_USER */
+
+/*
+ * FICL_WANT_LOCALS
+ * Controls the creation of the LOCALS wordset
+ * and a private dictionary for local variable compilation.
+ */
+#if !defined FICL_WANT_LOCALS
+#define	FICL_WANT_LOCALS	(1)
+#endif /* FICL_WANT_LOCALS */
+
+/*
+ * FICL_WANT_OOP
+ * Inludes object oriented programming support (in softwords)
+ * OOP support requires locals and user variables!
+ */
+#if !defined(FICL_WANT_OOP)
+#define	FICL_WANT_OOP	((FICL_WANT_LOCALS) && (FICL_WANT_USER))
+#endif /* FICL_WANT_OOP */
+
+/*
+ * FICL_WANT_SOFTWORDS
+ * Controls inclusion of all softwords in softcore.c.
+ */
+#if !defined(FICL_WANT_SOFTWORDS)
+#define	FICL_WANT_SOFTWORDS	(1)
+#endif /* FICL_WANT_SOFTWORDS */
+
+/*
+ * FICL_WANT_MULTITHREADED
+ * Enables dictionary mutual exclusion wia the
+ * ficlLockDictionary() system dependent function.
+ *
+ * Note: this implementation is experimental and poorly
+ * tested. Further, it's unnecessary unless you really
+ * intend to have multiple SESSIONS (poor choice of name
+ * on my part) - that is, threads that modify the dictionary
+ * at the same time.
+ */
+#if !defined FICL_WANT_MULTITHREADED
+#define	FICL_WANT_MULTITHREADED	(0)
+#endif /* FICL_WANT_MULTITHREADED */
+
+/*
+ * FICL_WANT_OPTIMIZE
+ * Do you want to optimize for size, or for speed?
+ * Note that this doesn't affect Ficl very much one way
+ * or the other at the moment.
+ * Contributed by Larry Hastings
+ */
+#define	FICL_OPTIMIZE_FOR_SPEED	(1)
+#define	FICL_OPTIMIZE_FOR_SIZE	(2)
+#if !defined(FICL_WANT_OPTIMIZE)
+#define	FICL_WANT_OPTIMIZE FICL_OPTIMIZE_FOR_SPEED
+#endif /* FICL_WANT_OPTIMIZE */
+
+/*
+ * FICL_WANT_VCALL
+ * Ficl OO support for calling vtable methods.  Win32 only.
+ * Contributed by Guy Carver
+ */
+#if !defined(FICL_WANT_VCALL)
+#define	FICL_WANT_VCALL	(0)
+#endif /* FICL_WANT_VCALL */
+
+/*
+ * P L A T F O R M   S E T T I N G S
+ *
+ * The FICL_PLATFORM_* settings.
+ * These indicate attributes about the local platform.
+ */
+
+/*
+ * FICL_PLATFORM_OS
+ * String constant describing the current hardware architecture.
+ */
+#if !defined(FICL_PLATFORM_ARCHITECTURE)
+#define	FICL_PLATFORM_ARCHITECTURE	"unknown"
+#endif
+
+/*
+ * FICL_PLATFORM_OS
+ * String constant describing the current operating system.
+ */
+#if !defined(FICL_PLATFORM_OS)
+#define	FICL_PLATFORM_OS	"unknown"
+#endif
+
+/*
+ * FICL_PLATFORM_HAS_2INTEGER
+ * Indicates whether or not the current architecture
+ * supports a native double-width integer type.
+ * If you set this to 1 in your ficlplatform/ *.h file,
+ * you *must* create typedefs for the following two types:
+ *        ficl2Unsigned
+ *        ficl2Integer
+ * If this is set to 0, Ficl will implement double-width
+ * integer math in C, which is both bigger *and* slower
+ * (the double whammy!).  Make sure your compiler really
+ * genuinely doesn't support native double-width integers
+ * before setting this to 0.
+ */
+#if !defined(FICL_PLATFORM_HAS_2INTEGER)
+#define	FICL_PLATFORM_HAS_2INTEGER	(0)
+#endif
+
+/*
+ * FICL_PLATFORM_HAS_FTRUNCATE
+ * Indicates whether or not the current platform provides
+ * the ftruncate() function (available on most UNIXes).
+ * This function is necessary to provide the complete
+ * File-Access wordset.
+ *
+ * If your platform does not have ftruncate() per se,
+ * but does have some method of truncating files, you
+ * should be able to implement ftruncate() yourself and
+ * set this constant to 1.  For an example of this see
+ * "ficlplatform/win32.c".
+ */
+#if !defined(FICL_PLATFORM_HAS_FTRUNCATE)
+#define	FICL_PLATFORM_HAS_FTRUNCATE	(0)
+#endif
+
+/*
+ * FICL_PLATFORM_INLINE
+ * Must be defined, should be a function prototype type-modifying
+ * keyword that makes a function "inline".  Ficl does not assume
+ * that the local platform supports inline functions; it therefore
+ * only uses "inline" where "static" would also work, and uses "static"
+ * in the absence of another keyword.
+ */
+#if !defined FICL_PLATFORM_INLINE
+#define	FICL_PLATFORM_INLINE	inline
+#endif /* !defined FICL_PLATFORM_INLINE */
+
+/*
+ * FICL_PLATFORM_EXTERN
+ * Must be defined, should be a keyword used to declare
+ * a function prototype as being a genuine prototype.
+ * You should only have to fiddle with this setting if
+ * you're not using an ANSI-compliant compiler, in which
+ * case, good luck!
+ */
+#if !defined FICL_PLATFORM_EXTERN
+#define	FICL_PLATFORM_EXTERN	extern
+#endif /* !defined FICL_PLATFORM_EXTERN */
+
+/*
+ * FICL_PLATFORM_BASIC_TYPES
+ *
+ * If not defined yet,
+ */
+#if !defined(FICL_PLATFORM_BASIC_TYPES)
+typedef char ficlInteger8;
+typedef unsigned char ficlUnsigned8;
+typedef short ficlInteger16;
+typedef unsigned short ficlUnsigned16;
+typedef long ficlInteger32;
+typedef unsigned long ficlUnsigned32;
+
+typedef ficlInteger32 ficlInteger;
+typedef ficlUnsigned32 ficlUnsigned;
+typedef float ficlFloat;
+
+#endif /* !defined(FICL_PLATFORM_BASIC_TYPES) */
+
+/*
+ * FICL_ROBUST enables bounds checking of stacks and the dictionary.
+ * This will detect stack over and underflows and dictionary overflows.
+ * Any exceptional condition will result in an assertion failure.
+ * (As generated by the ANSI assert macro)
+ * FICL_ROBUST == 1 --> stack checking in the outer interpreter
+ * FICL_ROBUST == 2 also enables checking in many primitives
+ */
+
+#if !defined FICL_ROBUST
+#define	FICL_ROBUST	(2)
+#endif /* FICL_ROBUST */
+
+/*
+ * FICL_DEFAULT_STACK_SIZE Specifies the default size (in CELLs) of
+ * a new virtual machine's stacks, unless overridden at
+ * create time.
+ */
+#if !defined FICL_DEFAULT_STACK_SIZE
+#define	FICL_DEFAULT_STACK_SIZE	(128)
+#endif
+
+/*
+ * FICL_DEFAULT_DICTIONARY_SIZE specifies the number of ficlCells to allocate
+ * for the system dictionary by default. The value
+ * can be overridden at startup time as well.
+ */
+#if !defined FICL_DEFAULT_DICTIONARY_SIZE
+#define	FICL_DEFAULT_DICTIONARY_SIZE	(12288)
+#endif
+
+/*
+ * FICL_DEFAULT_ENVIRONMENT_SIZE specifies the number of cells
+ * to allot for the environment-query dictionary.
+ */
+#if !defined FICL_DEFAULT_ENVIRONMENT_SIZE
+#define	FICL_DEFAULT_ENVIRONMENT_SIZE	(512)
+#endif
+
+/*
+ * FICL_MAX_WORDLISTS specifies the maximum number of wordlists in
+ * the dictionary search order. See Forth DPANS sec 16.3.3
+ * (file://dpans16.htm#16.3.3)
+ */
+#if !defined FICL_MAX_WORDLISTS
+#define	FICL_MAX_WORDLISTS	(16)
+#endif
+
+/*
+ * FICL_MAX_PARSE_STEPS controls the size of an array in the FICL_SYSTEM
+ * structure that stores pointers to parser extension functions. I would
+ * never expect to have more than 8 of these, so that's the default limit.
+ * Too many of these functions will probably exact a nasty performance penalty.
+ */
+#if !defined FICL_MAX_PARSE_STEPS
+#define	FICL_MAX_PARSE_STEPS	(8)
+#endif
+
+/*
+ * Maximum number of local variables per definition.
+ * This only affects the size of the locals dictionary,
+ * and there's only one per entire ficlSystem, so it
+ * doesn't make sense to be a piker here.
+ */
+#if (!defined(FICL_MAX_LOCALS)) && FICL_WANT_LOCALS
+#define	FICL_MAX_LOCALS	(64)
+#endif
+
+/*
+ * The pad is a small scratch area for text manipulation. ANS Forth
+ * requires it to hold at least 84 characters.
+ */
+#if !defined FICL_PAD_SIZE
+#define	FICL_PAD_SIZE	(256)
+#endif
+
+/*
+ * ANS Forth requires that a word's name contain {1..31} characters.
+ */
+#if !defined FICL_NAME_LENGTH
+#define	FICL_NAME_LENGTH	(31)
+#endif
+
+/*
+ * Default size of hash table. For most uniform
+ * performance, use a prime number!
+ */
+#if !defined FICL_HASH_SIZE
+#define	FICL_HASH_SIZE	(241)
+#endif
+
+/*
+ * Default number of USER flags.
+ */
+#if (!defined(FICL_USER_CELLS)) && FICL_WANT_USER
+#define	FICL_USER_CELLS	(16)
+#endif
+
+/*
+ * Forward declarations... read on.
+ */
+struct ficlWord;
+typedef struct ficlWord ficlWord;
+struct ficlVm;
+typedef struct ficlVm ficlVm;
+struct ficlDictionary;
+typedef struct ficlDictionary ficlDictionary;
+struct ficlSystem;
+typedef struct ficlSystem ficlSystem;
+struct ficlSystemInformation;
+typedef struct ficlSystemInformation ficlSystemInformation;
+struct ficlCallback;
+typedef struct ficlCallback ficlCallback;
+struct ficlCountedString;
+typedef struct ficlCountedString ficlCountedString;
+struct ficlString;
+typedef struct ficlString ficlString;
+
+
+/*
+ * System dependent routines:
+ * Edit the implementations in your appropriate ficlplatform/ *.c to be
+ * compatible with your runtime environment.
+ *
+ * ficlCallbackDefaultTextOut sends a zero-terminated string to the
+ *	default output device - used for system error messages.
+ *
+ * ficlMalloc(), ficlRealloc() and ficlFree() have the same semantics
+ * as the functions malloc(), realloc(), and free() from the standard C library.
+ */
+FICL_PLATFORM_EXTERN void ficlCallbackDefaultTextOut(ficlCallback *callback,
+    char *text);
+FICL_PLATFORM_EXTERN void *ficlMalloc(size_t size);
+FICL_PLATFORM_EXTERN void  ficlFree(void *p);
+FICL_PLATFORM_EXTERN void *ficlRealloc(void *p, size_t size);
+
+/*
+ * the Good Stuff starts here...
+ */
+#define	FICL_VERSION	"4.1.0"
+#define	FICL_VERSION_MAJOR	4
+#define	FICL_VERSION_MINOR	1
+
+#if !defined(FICL_PROMPT)
+#define	FICL_PROMPT		"ok> "
+#endif
+
+/*
+ * ANS Forth requires false to be zero, and true to be the ones
+ * complement of false... that unifies logical and bitwise operations
+ * nicely.
+ */
+#define	FICL_TRUE	((unsigned long)~(0L))
+#define	FICL_FALSE	(0)
+#define	FICL_BOOL(x)	((x) ? FICL_TRUE : FICL_FALSE)
+
+
+#if !defined FICL_IGNORE	/* Macro to silence unused param warnings */
+#define	FICL_IGNORE(x)	(void)x
+#endif /*  !defined FICL_IGNORE */
+
+#if !defined NULL
+#define	NULL	((void *)0)
+#endif
+
+/*
+ * 2integer structures
+ */
+#if FICL_PLATFORM_HAS_2INTEGER
+
+#define	FICL_2INTEGER_SET(high, low, doublei)	\
+	((doublei) = (ficl2Integer)(((ficlUnsigned)(low)) | \
+	(((ficl2Integer)(high)) << FICL_BITS_PER_CELL)))
+#define	FICL_2UNSIGNED_SET(high, low, doubleu)	\
+	((doubleu) = ((ficl2Unsigned)(low)) | \
+	(((ficl2Unsigned)(high)) << FICL_BITS_PER_CELL))
+#define	FICL_2UNSIGNED_GET_LOW(doubleu)	\
+	((ficlUnsigned)(doubleu & ((((ficl2Integer)1) << \
+	FICL_BITS_PER_CELL) - 1)))
+#define	FICL_2UNSIGNED_GET_HIGH(doubleu)	\
+	((ficlUnsigned)(doubleu >> FICL_BITS_PER_CELL))
+#define	FICL_2UNSIGNED_NOT_ZERO(doubleu)	((doubleu) != 0)
+
+#define	FICL_INTEGER_TO_2INTEGER(i, doublei)	((doublei) = (i))
+#define	FICL_UNSIGNED_TO_2UNSIGNED(u, doubleu)	((doubleu) = (u))
+
+#define	ficl2IntegerIsNegative(doublei)	((doublei) < 0)
+#define	ficl2IntegerNegate(doublei)	(-(doublei))
+
+#define	ficl2IntegerMultiply(x, y)	\
+	(((ficl2Integer)(x)) * ((ficl2Integer)(y)))
+#define	ficl2IntegerDecrement(x)	(((ficl2Integer)(x)) - 1)
+
+#define	ficl2UnsignedAdd(x, y)	(((ficl2Unsigned)(x)) + ((ficl2Unsigned)(y)))
+#define	ficl2UnsignedSubtract(x, y)	\
+	(((ficl2Unsigned)(x)) - ((ficl2Unsigned)(y)))
+#define	ficl2UnsignedMultiply(x, y)	\
+	(((ficl2Unsigned)(x)) * ((ficl2Unsigned)(y)))
+#define	ficl2UnsignedMultiplyAccumulate(u, mul, add)	(((u) * (mul)) + (add))
+#define	ficl2UnsignedArithmeticShiftLeft(x)	((x) << 1)
+#define	ficl2UnsignedArithmeticShiftRight(x)	((x) >> 1)
+#define	ficl2UnsignedCompare(x, y)	ficl2UnsignedSubtract(x, y)
+#define	ficl2UnsignedOr(x, y)	((x) | (y))
+
+#else /* FICL_PLATFORM_HAS_2INTEGER */
+
+typedef struct
+{
+	ficlUnsigned high;
+	ficlUnsigned low;
+} ficl2Unsigned;
+
+typedef struct
+{
+	ficlInteger high;
+	ficlInteger low;
+} ficl2Integer;
+
+
+#define	FICL_2INTEGER_SET(hi, lo, doublei)	\
+	{ ficl2Integer x; x.low = (lo); x.high = (hi); (doublei) = x; }
+#define	FICL_2UNSIGNED_SET(hi, lo, doubleu)	\
+	{ ficl2Unsigned x; x.low = (lo); x.high = (hi); (doubleu) = x; }
+#define	FICL_2UNSIGNED_GET_LOW(doubleu)	((doubleu).low)
+#define	FICL_2UNSIGNED_GET_HIGH(doubleu)	((doubleu).high)
+#define	FICL_2UNSIGNED_NOT_ZERO(doubleu) ((doubleu).high || (doubleu).low)
+
+#define	FICL_INTEGER_TO_2INTEGER(i, doublei)	\
+	{ ficlInteger __x = (ficlInteger)(i);	\
+	FICL_2INTEGER_SET((__x < 0) ? -1L : 0, __x, doublei) }
+#define	FICL_UNSIGNED_TO_2UNSIGNED(u, doubleu)	\
+	FICL_2UNSIGNED_SET(0, u, doubleu)
+
+FICL_PLATFORM_EXTERN int ficl2IntegerIsNegative(ficl2Integer x);
+FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerNegate(ficl2Integer x);
+
+FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerMultiply(ficlInteger x,
+    ficlInteger y);
+FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerDecrement(ficl2Integer x);
+
+FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedAdd(ficl2Unsigned x,
+    ficl2Unsigned y);
+FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedSubtract(ficl2Unsigned x,
+    ficl2Unsigned y);
+FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedMultiply(ficlUnsigned x,
+    ficlUnsigned y);
+FICL_PLATFORM_EXTERN ficl2Unsigned
+    ficl2UnsignedMultiplyAccumulate(ficl2Unsigned u, ficlUnsigned mul,
+    ficlUnsigned add);
+FICL_PLATFORM_EXTERN ficl2Unsigned
+    ficl2UnsignedArithmeticShiftLeft(ficl2Unsigned x);
+FICL_PLATFORM_EXTERN ficl2Unsigned
+    ficl2UnsignedArithmeticShiftRight(ficl2Unsigned x);
+FICL_PLATFORM_EXTERN int ficl2UnsignedCompare(ficl2Unsigned x,
+    ficl2Unsigned y);
+FICL_PLATFORM_EXTERN ficl2Unsigned
+    ficl2UnsignedOr(ficl2Unsigned x, ficl2Unsigned y);
+
+#endif /* FICL_PLATFORM_HAS_2INTEGER */
+
+/*
+ * These structures represent the result of division.
+ */
+typedef struct
+{
+	ficl2Unsigned quotient;
+	ficlUnsigned remainder;
+} __attribute__((may_alias)) ficl2UnsignedQR;
+
+typedef struct
+{
+	ficl2Integer quotient;
+	ficlInteger remainder;
+} __attribute__((may_alias)) ficl2IntegerQR;
+
+
+#define	FICL_2INTEGERQR_TO_2UNSIGNEDQR(doubleiqr)	\
+	(*(ficl2UnsignedQR *)(&(doubleiqr)))
+#define	FICL_2UNSIGNEDQR_TO_2INTEGERQR(doubleuqr)	\
+	(*(ficl2IntegerQR *)(&(doubleuqr)))
+
+/*
+ * 64 bit integer math support routines: multiply two UNS32s
+ * to get a 64 bit product, & divide the product by an UNS32
+ * to get an UNS32 quotient and remainder. Much easier in asm
+ * on a 32 bit CPU than in C, which usually doesn't support
+ * the double length result (but it should).
+ */
+FICL_PLATFORM_EXTERN ficl2IntegerQR
+    ficl2IntegerDivideFloored(ficl2Integer num, ficlInteger den);
+FICL_PLATFORM_EXTERN ficl2IntegerQR
+    ficl2IntegerDivideSymmetric(ficl2Integer num, ficlInteger den);
+
+FICL_PLATFORM_EXTERN ficl2UnsignedQR
+    ficl2UnsignedDivide(ficl2Unsigned q, ficlUnsigned y);
+
+/*
+ * A ficlCell 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 int,
+ * unsigned, and float.
+ *
+ * A ficlUnsigned, ficlInteger, and ficlFloat *MUST* be the same
+ * size as a "void *" on the target system.  (Sorry, but that's
+ * a design constraint of FORTH.)
+ */
+typedef union ficlCell
+{
+    ficlInteger i;
+    ficlUnsigned u;
+#if (FICL_WANT_FLOAT)
+    ficlFloat f;
+#endif
+    void *p;
+    void (*fn)(void);
+} __attribute__((may_alias)) ficlCell;
+
+
+#define	FICL_BITS_PER_CELL	(sizeof (ficlCell) * 8)
+
+/*
+ * FICL_PLATFORM_ALIGNMENT is the number of bytes to which
+ * the dictionary pointer address must be aligned. This value
+ * is usually either 2 or 4, depending on the memory architecture
+ * of the target system; 4 is safe on any 16 or 32 bit
+ * machine.  8 would be appropriate for a 64 bit machine.
+ */
+#if !defined FICL_PLATFORM_ALIGNMENT
+#define	FICL_PLATFORM_ALIGNMENT	(4)
+#endif
+
+/*
+ * PTRtoCELL is a cast through void * intended to satisfy the
+ * most outrageously pedantic compiler... (I won't mention
+ * its name)
+ */
+#define	FICL_POINTER_TO_CELL(p)	((ficlCell *)(void *)p)
+
+/*
+ * FORTH defines the "counted string" data type.  This is
+ * a "Pascal-style" string, where the first byte is an unsigned
+ * count of characters, followed by the characters themselves.
+ * The Ficl structure for this is ficlCountedString.
+ * Ficl also often zero-terminates them so that they work with the
+ * usual C runtime library string functions... strlen(), strcmp(),
+ * and the like.  (Belt & suspenders?  You decide.)
+ *
+ * The problem is, this limits strings to 255 characters, which
+ * can be a bit constricting to us wordy types.  So FORTH only
+ * uses counted strings for backwards compatibility, and all new
+ * words are "c-addr u" style, where the address and length are
+ * stored separately, and the length is a full unsigned "cell" size.
+ * (For more on this trend, see DPANS94 section A.3.1.3.4.)
+ * Ficl represents this with the ficlString structure.  Note that
+ * these are frequently *not* zero-terminated!  Don't depend on
+ * it--that way lies madness.
+ */
+
+struct ficlCountedString
+{
+    ficlUnsigned8 length;
+    char text[1];
+};
+
+#define	FICL_COUNTED_STRING_GET_LENGTH(cs)	((cs).length)
+#define	FICL_COUNTED_STRING_GET_POINTER(cs)	((cs).text)
+
+#define	FICL_COUNTED_STRING_MAX	(256)
+#define	FICL_POINTER_TO_COUNTED_STRING(p)	((ficlCountedString *)(void *)p)
+
+struct ficlString
+{
+    ficlUnsigned length;
+    char *text;
+};
+
+
+#define	FICL_STRING_GET_LENGTH(fs)	((fs).length)
+#define	FICL_STRING_GET_POINTER(fs)	((fs).text)
+#define	FICL_STRING_SET_LENGTH(fs, l)	((fs).length = (ficlUnsigned)(l))
+#define	FICL_STRING_SET_POINTER(fs, p)	((fs).text = (char *)(p))
+#define	FICL_STRING_SET_FROM_COUNTED_STRING(string, countedstring)	\
+	{(string).text = (countedstring).text;	\
+	(string).length = (countedstring).length; }
+/*
+ * Init a FICL_STRING from a pointer to a zero-terminated string
+ */
+#define	FICL_STRING_SET_FROM_CSTRING(string, cstring) \
+	{(string).text = (cstring); (string).length = strlen(cstring); }
+
+/*
+ * Ficl uses this little structure to hold the address of
+ * the block of text it's working on and an index to the next
+ * unconsumed character in the string. Traditionally, this is
+ * done by a Text Input Buffer, so I've called this struct TIB.
+ *
+ * Since this structure also holds the size of the input buffer,
+ * and since evaluate requires that, let's put the size here.
+ * The size is stored as an end-pointer because that is what the
+ * null-terminated string aware functions find most easy to deal
+ * with.
+ * Notice, though, that nobody really uses this except evaluate,
+ * so it might just be moved to ficlVm instead. (sobral)
+ */
+typedef struct
+{
+    ficlInteger index;
+    char *end;
+    char *text;
+} ficlTIB;
+
+/*
+ * Stacks get heavy use in Ficl and Forth...
+ * Each virtual machine implements two of them:
+ * one holds parameters (data), and the other holds return
+ * addresses and control flow information for the virtual
+ * machine. (Note: C's automatic stack is implicitly used,
+ * but not modeled because it doesn't need to be...)
+ * Here's an abstract type for a stack
+ */
+typedef struct ficlStack
+{
+    ficlUnsigned size;	/* size of the stack, in cells */
+    ficlCell *frame;	/* link reg for stack frame */
+    ficlCell *top;	/* stack pointer */
+    ficlVm *vm;		/* used for debugging */
+    char *name;		/* used for debugging */
+    ficlCell base[1];	/* Top of stack */
+} ficlStack;
+
+/*
+ * Stack methods... many map closely to required Forth words.
+ */
+FICL_PLATFORM_EXTERN ficlStack *
+    ficlStackCreate(ficlVm *vm, char *name, unsigned nCells);
+FICL_PLATFORM_EXTERN void ficlStackDestroy(ficlStack *stack);
+FICL_PLATFORM_EXTERN int ficlStackDepth(ficlStack *stack);
+FICL_PLATFORM_EXTERN void ficlStackDrop(ficlStack *stack, int n);
+FICL_PLATFORM_EXTERN ficlCell ficlStackFetch(ficlStack *stack, int n);
+FICL_PLATFORM_EXTERN ficlCell ficlStackGetTop(ficlStack *stack);
+FICL_PLATFORM_EXTERN void ficlStackPick(ficlStack *stack, int n);
+FICL_PLATFORM_EXTERN ficlCell ficlStackPop(ficlStack *stack);
+FICL_PLATFORM_EXTERN void ficlStackPush(ficlStack *stack, ficlCell c);
+FICL_PLATFORM_EXTERN void ficlStackReset(ficlStack *stack);
+FICL_PLATFORM_EXTERN void ficlStackRoll(ficlStack *stack, int n);
+FICL_PLATFORM_EXTERN void ficlStackSetTop(ficlStack *stack, ficlCell c);
+FICL_PLATFORM_EXTERN void ficlStackStore(ficlStack *stack, int n, ficlCell c);
+
+#if FICL_WANT_LOCALS
+FICL_PLATFORM_EXTERN void ficlStackLink(ficlStack *stack, int nCells);
+FICL_PLATFORM_EXTERN void ficlStackUnlink(ficlStack *stack);
+#endif /* FICL_WANT_LOCALS */
+
+FICL_PLATFORM_EXTERN void *ficlStackPopPointer(ficlStack *stack);
+FICL_PLATFORM_EXTERN ficlUnsigned ficlStackPopUnsigned(ficlStack *stack);
+FICL_PLATFORM_EXTERN ficlInteger ficlStackPopInteger(ficlStack *stack);
+FICL_PLATFORM_EXTERN void ficlStackPushPointer(ficlStack *stack, void *ptr);
+FICL_PLATFORM_EXTERN void
+	ficlStackPushUnsigned(ficlStack *stack, ficlUnsigned u);
+FICL_PLATFORM_EXTERN void ficlStackPushInteger(ficlStack *stack, ficlInteger i);
+
+#if (FICL_WANT_FLOAT)
+FICL_PLATFORM_EXTERN ficlFloat ficlStackPopFloat(ficlStack *stack);
+FICL_PLATFORM_EXTERN void ficlStackPushFloat(ficlStack *stack, ficlFloat f);
+#endif
+
+FICL_PLATFORM_EXTERN void
+	ficlStackPush2Integer(ficlStack *stack, ficl2Integer i64);
+FICL_PLATFORM_EXTERN ficl2Integer ficlStackPop2Integer(ficlStack *stack);
+FICL_PLATFORM_EXTERN void
+	ficlStackPush2Unsigned(ficlStack *stack, ficl2Unsigned u64);
+FICL_PLATFORM_EXTERN ficl2Unsigned ficlStackPop2Unsigned(ficlStack *stack);
+
+#if FICL_ROBUST >= 1
+FICL_PLATFORM_EXTERN void
+	ficlStackCheck(ficlStack *stack, int popCells, int pushCells);
+#define	FICL_STACK_CHECK(stack, popCells, pushCells)	\
+	ficlStackCheck(stack, popCells, pushCells)
+#else /* FICL_ROBUST >= 1 */
+#define	FICL_STACK_CHECK(stack, popCells, pushCells)
+#endif /* FICL_ROBUST >= 1 */
+
+typedef ficlInteger (*ficlStackWalkFunction)(void *constant, ficlCell *cell);
+FICL_PLATFORM_EXTERN void
+	ficlStackWalk(ficlStack *stack, ficlStackWalkFunction callback,
+	void *context, ficlInteger bottomToTop);
+FICL_PLATFORM_EXTERN void ficlStackDisplay(ficlStack *stack,
+	ficlStackWalkFunction callback, void *context);
+
+typedef ficlWord **ficlIp; /* the VM's instruction pointer */
+typedef void (*ficlPrimitive)(ficlVm *vm);
+typedef void (*ficlOutputFunction)(ficlCallback *callback, char *text);
+
+/*
+ * Each VM has a placeholder for an output function -
+ * this makes it possible to have each VM do I/O
+ * through a different device. If you specify no
+ * ficlOutputFunction, it defaults to ficlCallbackDefaultTextOut.
+ *
+ * You can also set a specific handler just for errors.
+ * If you don't specify one, it defaults to using textOut.
+ */
+
+struct ficlCallback
+{
+    void *context;
+    ficlOutputFunction textOut;
+    ficlOutputFunction errorOut;
+    ficlSystem *system;
+    ficlVm *vm;
+};
+
+FICL_PLATFORM_EXTERN void
+    ficlCallbackTextOut(ficlCallback *callback, char *text);
+FICL_PLATFORM_EXTERN void
+    ficlCallbackErrorOut(ficlCallback *callback, char *text);
+
+/*
+ * For backwards compatibility.
+ */
+typedef void
+(*ficlCompatibilityOutputFunction)(ficlVm *vm, char *text, int newline);
+FICL_PLATFORM_EXTERN void
+    ficlCompatibilityTextOutCallback(ficlCallback *callback, char *text,
+    ficlCompatibilityOutputFunction oldFunction);
+
+/*
+ * Starting with Ficl 4.0, Ficl uses a "switch-threaded" inner loop,
+ * where each primitive word is represented with a numeric constant,
+ * and words are (more or less) arrays of these constants.  In Ficl
+ * these constants are an enumerated type called ficlInstruction.
+ */
+enum ficlInstruction
+{
+#define	FICL_TOKEN(token, description) token,
+#define	FICL_INSTRUCTION_TOKEN(token, description, flags) token,
+#include "ficltokens.h"
+#undef	FICL_TOKEN
+#undef	FICL_INSTRUCTION_TOKEN
+
+	ficlInstructionLast,
+
+	ficlInstructionFourByteTrick = 0x10000000
+};
+typedef intptr_t ficlInstruction;
+
+/*
+ * The virtual machine (VM) contains the state for one interpreter.
+ * Defined operations include:
+ * Create & initialize
+ * Delete
+ * Execute a block of text
+ * Parse a word out of the input stream
+ * Call return, and branch
+ * Text output
+ * Throw an exception
+ */
+
+struct ficlVm
+{
+	ficlCallback callback;
+	ficlVm *link;		/* Ficl keeps a VM list for simple teardown */
+	jmp_buf *exceptionHandler; /* crude exception mechanism... */
+	short restart;		/* Set TRUE to restart runningWord */
+	ficlIp ip;		/* instruction pointer */
+		/* address of currently running word (often just *(ip-1) ) */
+	ficlWord *runningWord;
+	ficlUnsigned state;	/* compiling or interpreting */
+	ficlUnsigned base;	/* number conversion base */
+	ficlStack *dataStack;
+	ficlStack *returnStack;	/* return stack */
+#if FICL_WANT_FLOAT
+	ficlStack *floatStack;	/* float stack (optional) */
+#endif
+	ficlCell sourceId; /* -1 if EVALUATE, 0 if normal input, >0 if a file */
+	ficlTIB	 tib;		/* address of incoming text string  */
+#if FICL_WANT_USER
+	ficlCell user[FICL_USER_CELLS];
+#endif
+	char pad[FICL_PAD_SIZE];	/* the scratch area (see above) */
+};
+
+/*
+ * Each VM operates in one of two non-error states: interpreting
+ * or compiling. When interpreting, words are simply executed.
+ * When compiling, most words in the input stream have their
+ * addresses inserted into the word under construction. Some words
+ * (known as IMMEDIATE) are executed in the compile state, too.
+ */
+/* values of STATE */
+#define	FICL_VM_STATE_INTERPRET	(0)
+#define	FICL_VM_STATE_COMPILE	(1)
+
+/*
+ * Exit codes for vmThrow
+ */
+/* tell ficlVmExecuteXT to exit inner loop */
+#define	FICL_VM_STATUS_INNER_EXIT	(-256)
+/* hungry - normal exit */
+#define	FICL_VM_STATUS_OUT_OF_TEXT	(-257)
+/* word needs more text to succeed -- re-run it */
+#define	FICL_VM_STATUS_RESTART		(-258)
+/* user wants to quit */
+#define	FICL_VM_STATUS_USER_EXIT	(-259)
+/* interpreter found an error */
+#define	FICL_VM_STATUS_ERROR_EXIT	(-260)
+/* debugger breakpoint */
+#define	FICL_VM_STATUS_BREAK		(-261)
+/* like FICL_VM_STATUS_ERROR_EXIT -- abort */
+#define	FICL_VM_STATUS_ABORT		(-1)
+/* like FICL_VM_STATUS_ERROR_EXIT -- abort" */
+#define	FICL_VM_STATUS_ABORTQ		(-2)
+/* like FICL_VM_STATUS_ERROR_EXIT, but leave dataStack & base alone */
+#define	FICL_VM_STATUS_QUIT		(-56)
+
+FICL_PLATFORM_EXTERN void ficlVmBranchRelative(ficlVm *vm, int offset);
+FICL_PLATFORM_EXTERN ficlVm *
+ficlVmCreate(ficlVm *vm, unsigned nPStack, unsigned nRStack);
+FICL_PLATFORM_EXTERN void ficlVmDestroy(ficlVm *vm);
+FICL_PLATFORM_EXTERN ficlDictionary *ficlVmGetDictionary(ficlVm *vm);
+FICL_PLATFORM_EXTERN char *
+ficlVmGetString(ficlVm *vm, ficlCountedString *spDest, char delimiter);
+FICL_PLATFORM_EXTERN ficlString ficlVmGetWord(ficlVm *vm);
+FICL_PLATFORM_EXTERN ficlString ficlVmGetWord0(ficlVm *vm);
+FICL_PLATFORM_EXTERN int ficlVmGetWordToPad(ficlVm *vm);
+FICL_PLATFORM_EXTERN void ficlVmInnerLoop(ficlVm *vm, ficlWord *word);
+FICL_PLATFORM_EXTERN ficlString ficlVmParseString(ficlVm *vm, char delimiter);
+FICL_PLATFORM_EXTERN ficlString
+ficlVmParseStringEx(ficlVm *vm, char delimiter, char fSkipLeading);
+FICL_PLATFORM_EXTERN ficlCell ficlVmPop(ficlVm *vm);
+FICL_PLATFORM_EXTERN void ficlVmPush(ficlVm *vm, ficlCell c);
+FICL_PLATFORM_EXTERN void ficlVmPopIP(ficlVm *vm);
+FICL_PLATFORM_EXTERN void ficlVmPushIP(ficlVm *vm, ficlIp newIP);
+FICL_PLATFORM_EXTERN void ficlVmQuit(ficlVm *vm);
+FICL_PLATFORM_EXTERN void ficlVmReset(ficlVm *vm);
+FICL_PLATFORM_EXTERN void
+ficlVmSetTextOut(ficlVm *vm, ficlOutputFunction textOut);
+FICL_PLATFORM_EXTERN void ficlVmThrow(ficlVm *vm, int except);
+FICL_PLATFORM_EXTERN void ficlVmThrowError(ficlVm *vm, char *fmt, ...);
+FICL_PLATFORM_EXTERN void
+ficlVmThrowErrorVararg(ficlVm *vm, char *fmt, va_list list);
+FICL_PLATFORM_EXTERN void ficlVmTextOut(ficlVm *vm, char *text);
+FICL_PLATFORM_EXTERN void ficlVmErrorOut(ficlVm *vm, char *text);
+
+#define	ficlVmGetContext(vm)		((vm)->callback.context)
+#define	ficlVmGetDataStack(vm)		((vm)->dataStack)
+#define	ficlVmGetFloatStack(vm)		((vm)->floatStack)
+#define	ficlVmGetReturnStack(vm)	((vm)->returnStack)
+#define	ficlVmGetRunningWord(vm)	((vm)->runningWord)
+
+FICL_PLATFORM_EXTERN void ficlVmDisplayDataStack(ficlVm *vm);
+FICL_PLATFORM_EXTERN void ficlVmDisplayDataStackSimple(ficlVm *vm);
+FICL_PLATFORM_EXTERN void ficlVmDisplayReturnStack(ficlVm *vm);
+#if FICL_WANT_FLOAT
+FICL_PLATFORM_EXTERN void ficlVmDisplayFloatStack(ficlVm *vm);
+#endif /* FICL_WANT_FLOAT */
+
+/*
+ * 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.
+ */
+FICL_PLATFORM_EXTERN int ficlVmEvaluate(ficlVm *vm, char *s);
+
+/*
+ * f i c l V m E x e c *
+ * Evaluates a block of input text in the context of the
+ * specified interpreter. Emits any requested output to the
+ * interpreter's output function. If the input string is NULL
+ * terminated, you can pass -1 as nChars rather than count it.
+ * Execution returns when the text block has been executed,
+ * or an error occurs.
+ * Returns one of the FICL_VM_STATUS_... codes defined in ficl.h:
+ * FICL_VM_STATUS_OUT_OF_TEXT is the normal exit condition
+ * FICL_VM_STATUS_ERROR_EXIT means that the interpreter encountered a syntax
+ *	error and the vm has been reset to recover (some or all
+ *      of the text block got ignored
+ * FICL_VM_STATUS_USER_EXIT means that the user executed the "bye" command
+ *      to shut down the interpreter. This would be a good
+ *      time to delete the vm, etc -- or you can ignore this
+ *      signal.
+ * FICL_VM_STATUS_ABORT and FICL_VM_STATUS_ABORTQ are generated by 'abort'
+ *	 and 'abort"' commands.
+ * Preconditions: successful execution of ficlInitSystem,
+ *      Successful creation and init of the VM by ficlNewVM (or equivalent)
+ *
+ * If you call ficlExec() or one of its brothers, you MUST
+ * ensure vm->sourceId was set to a sensible value.
+ * ficlExec() explicitly DOES NOT manage SOURCE-ID for you.
+ */
+FICL_PLATFORM_EXTERN int ficlVmExecuteString(ficlVm *vm, ficlString s);
+FICL_PLATFORM_EXTERN int ficlVmExecuteXT(ficlVm *vm, ficlWord *pWord);
+FICL_PLATFORM_EXTERN void
+ficlVmExecuteInstruction(ficlVm *vm, ficlInstruction i);
+FICL_PLATFORM_EXTERN void ficlVmExecuteWord(ficlVm *vm, ficlWord *pWord);
+FICL_PLATFORM_EXTERN int ficlExecFD(ficlVm *vm, int fd);
+
+FICL_PLATFORM_EXTERN void
+ficlVmDictionaryAllot(ficlVm *vm, ficlDictionary *dictionary, int n);
+FICL_PLATFORM_EXTERN void
+ficlVmDictionaryAllotCells(ficlVm *vm, ficlDictionary *dictionary, int cells);
+
+FICL_PLATFORM_EXTERN int ficlVmParseWord(ficlVm *vm, ficlString s);
+
+/*
+ * TIB access routines...
+ * ANS forth seems to require the input buffer to be represented
+ * as a pointer to the start of the buffer, and an index to the
+ * next character to read.
+ * PushTib points the VM to a new input string and optionally
+ *  returns a copy of the current state
+ * PopTib restores the TIB state given a saved TIB from PushTib
+ * GetInBuf returns a pointer to the next unused char of the TIB
+ */
+FICL_PLATFORM_EXTERN void
+ficlVmPushTib(ficlVm *vm, char *text, ficlInteger nChars, ficlTIB *pSaveTib);
+FICL_PLATFORM_EXTERN void ficlVmPopTib(ficlVm *vm, ficlTIB *pTib);
+#define	ficlVmGetInBuf(vm)	((vm)->tib.text + (vm)->tib.index)
+#define	ficlVmGetInBufLen(vm)	((vm)->tib.end - (vm)->tib.text)
+#define	ficlVmGetInBufEnd(vm)	((vm)->tib.end)
+#define	ficlVmGetTibIndex(vm)	((vm)->tib.index)
+#define	ficlVmSetTibIndex(vm, i)	((vm)->tib.index = i)
+#define	ficlVmUpdateTib(vm, str)	\
+	((vm)->tib.index = (str) - (vm)->tib.text)
+
+#if FICL_ROBUST >= 1
+FICL_PLATFORM_EXTERN void
+ficlVmDictionaryCheck(ficlVm *vm, ficlDictionary *dictionary, int n);
+FICL_PLATFORM_EXTERN void
+ficlVmDictionarySimpleCheck(ficlVm *vm, ficlDictionary *dictionary, int n);
+#define	FICL_VM_DICTIONARY_CHECK(vm, dictionary, n)	\
+	ficlVmDictionaryCheck(vm, dictionary, n)
+#define	FICL_VM_DICTIONARY_SIMPLE_CHECK(vm, dictionary, n)	\
+	ficlVmDictionarySimpleCheck(vm, dictionary, n)
+#else
+#define	FICL_VM_DICTIONARY_CHECK(vm, dictionary, n)
+#define	FICL_VM_DICTIONARY_SIMPLE_CHECK(vm, dictionary, n)
+#endif /* FICL_ROBUST >= 1 */
+
+FICL_PLATFORM_EXTERN void ficlPrimitiveLiteralIm(ficlVm *vm);
+
+/*
+ * A FICL_CODE points to a function that gets called to help execute
+ * a word in the dictionary. It always gets passed a pointer to the
+ * running virtual machine, and from there it can get the address
+ * of the parameter area of the word it's supposed to operate on.
+ * For precompiled words, the code is all there is. For user defined
+ * words, the code assumes that the word's parameter area is a list
+ * of pointers to the code fields of other words to execute, and
+ * may also contain inline data. The first parameter is always
+ * a pointer to a code field.
+ */
+
+/*
+ * Ficl models memory as a contiguous space divided into
+ * words in a linked list called the dictionary.
+ * A ficlWord starts each entry in the list.
+ * Version 1.02: space for the name characters is allotted from
+ * the dictionary ahead of the word struct, rather than using
+ * a fixed size array for each name.
+ */
+struct ficlWord
+{
+    struct ficlWord *link;	/* Previous word in the dictionary */
+    ficlUnsigned16 hash;
+		/* Immediate, Smudge, Compile-only, IsOjbect, Instruction */
+    ficlUnsigned8 flags;
+    ficlUnsigned8 length;	/* Number of chars in word name */
+    char *name;			/* First nFICLNAME chars of word name */
+    ficlPrimitive code;		/* Native code to execute the word */
+    ficlInstruction semiParen;	/* Native code to execute the word */
+    ficlCell param[1];		/* First data cell of the word */
+};
+
+/*
+ * ficlWord.flag bitfield values:
+ */
+
+/*
+ * FICL_WORD_IMMEDIATE:
+ * This word is always executed immediately when
+ * encountered, even when compiling.
+ */
+#define	FICL_WORD_IMMEDIATE	(1)
+
+/*
+ * FICL_WORD_COMPILE_ONLY:
+ * This word is only valid during compilation.
+ * Ficl will throw a runtime error if this word executed
+ * while not compiling.
+ */
+#define	FICL_WORD_COMPILE_ONLY	(2)
+
+/*
+ * FICL_WORD_SMUDGED
+ * This word's definition is in progress.
+ * The word is hidden from dictionary lookups
+ * until it is "un-smudged".
+ */
+#define	FICL_WORD_SMUDGED	(4)
+
+/*
+ * FICL_WORD_OBJECT
+ * This word is an object or object member variable.
+ * (Currently only used by "my=[".)
+ */
+#define	FICL_WORD_OBJECT	(8)
+
+/*
+ * FICL_WORD_INSTRUCTION
+ * This word represents a ficlInstruction, not a normal word.
+ * param[0] is the instruction.
+ * When compiled, Ficl will simply copy over the instruction,
+ * rather than executing the word as normal.
+ *
+ * (Do *not* use this flag for words that need their PFA pushed
+ * before executing!)
+ */
+#define	FICL_WORD_INSTRUCTION	(16)
+
+/*
+ * FICL_WORD_COMPILE_ONLY_IMMEDIATE
+ * Most words that are "immediate" are also
+ * "compile-only".
+ */
+#define	FICL_WORD_COMPILE_ONLY_IMMEDIATE	\
+	(FICL_WORD_IMMEDIATE | FICL_WORD_COMPILE_ONLY)
+#define	FICL_WORD_DEFAULT	(0)
+
+/*
+ * Worst-case size of a word header: FICL_NAME_LENGTH chars in name
+ */
+#define	FICL_CELLS_PER_WORD	\
+	((sizeof (ficlWord) + FICL_NAME_LENGTH + sizeof (ficlCell)) \
+	/ (sizeof (ficlCell)))
+
+FICL_PLATFORM_EXTERN int ficlWordIsImmediate(ficlWord *word);
+FICL_PLATFORM_EXTERN int ficlWordIsCompileOnly(ficlWord *word);
+
+#if FICL_ROBUST >= 1
+FICL_PLATFORM_EXTERN void
+ficlCallbackAssert(ficlCallback *callback, int expression,
+    char *expressionString, char *filename, int line);
+#define	FICL_ASSERT(callback, expression)	\
+(ficlCallbackAssert((callback), (expression) != 0, \
+#expression, __FILE__, __LINE__))
+#else
+#define	FICL_ASSERT(callback, expression)
+#endif /* FICL_ROBUST >= 1 */
+
+#define	FICL_VM_ASSERT(vm, expression)	\
+	FICL_ASSERT((ficlCallback *)(vm), (expression))
+#define	FICL_SYSTEM_ASSERT(system, expression)	\
+	FICL_ASSERT((ficlCallback *)(system), (expression))
+
+/*
+ * Generally useful string manipulators omitted by ANSI C...
+ * ltoa complements strtol
+ */
+
+FICL_PLATFORM_EXTERN int ficlIsPowerOfTwo(ficlUnsigned u);
+FICL_PLATFORM_EXTERN char *
+ficlLtoa(ficlInteger value, char *string, int radix);
+FICL_PLATFORM_EXTERN char *
+ficlUltoa(ficlUnsigned value, char *string, int radix);
+FICL_PLATFORM_EXTERN char ficlDigitToCharacter(int value);
+FICL_PLATFORM_EXTERN char *ficlStringReverse(char *string);
+FICL_PLATFORM_EXTERN char *ficlStringSkipSpace(char *s, char *end);
+FICL_PLATFORM_EXTERN char *ficlStringCaseFold(char *s);
+FICL_PLATFORM_EXTERN int ficlStrincmp(char *s1, char *s2, ficlUnsigned length);
+FICL_PLATFORM_EXTERN void *ficlAlignPointer(void *ptr);
+
+/*
+ * Ficl hash table - variable size.
+ * assert(size > 0)
+ * If size is 1, the table degenerates into a linked list.
+ * A WORDLIST (see the search order word set in DPANS) is
+ * just a pointer to a FICL_HASH in this implementation.
+ */
+typedef struct ficlHash
+{
+    struct ficlHash *link;	/* link to parent class wordlist for OO */
+    char *name;		/* optional pointer to \0 terminated wordlist name */
+    unsigned size;		/* number of buckets in the hash */
+    ficlWord *table[1];
+} ficlHash;
+
+FICL_PLATFORM_EXTERN void ficlHashForget(ficlHash *hash, void *where);
+FICL_PLATFORM_EXTERN ficlUnsigned16 ficlHashCode(ficlString s);
+FICL_PLATFORM_EXTERN void ficlHashInsertWord(ficlHash *hash, ficlWord *word);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlHashLookup(ficlHash *hash, ficlString name, ficlUnsigned16 hashCode);
+FICL_PLATFORM_EXTERN void ficlHashReset(ficlHash *hash);
+
+/*
+ * A Dictionary is a linked list of FICL_WORDs. It is also Ficl's
+ * memory model. Description of fields:
+ *
+ * here -- points to the next free byte in the dictionary. This
+ *	pointer is forced to be CELL-aligned before a definition is added.
+ *	Do not assume any specific alignment otherwise - Use dictAlign().
+ *
+ * smudge -- pointer to word currently being defined (or last defined word)
+ *	If the definition completes successfully, the word will be
+ *	linked into the hash table. If unsuccessful, dictUnsmudge
+ *	uses this pointer to restore the previous state of the dictionary.
+ *	Smudge prevents unintentional recursion as a side-effect: the
+ *	dictionary search algo examines only completed definitions, so a
+ *	word cannot invoke itself by name. See the Ficl word "recurse".
+ *	NOTE: smudge always points to the last word defined. IMMEDIATE
+ *	makes use of this fact. Smudge is initially NULL.
+ *
+ * forthWordlist -- pointer to the default wordlist (FICL_HASH).
+ *	This is the initial compilation list, and contains all
+ *	Ficl's precompiled words.
+ *
+ * compilationWordlist -- compilation wordlist - initially equal to
+ * forthWordlist wordlists  -- array of pointers to wordlists.
+ *	Managed as a stack.
+ *	Highest index is the first list in the search order.
+ * wordlistCount   -- number of lists in wordlists. wordlistCount-1 is the
+ *	highest filled slot in wordlists, and points to the first wordlist
+ *	in the search order
+ * size -- number of cells in the dictionary (total)
+ * base -- start of data area. Must be at the end of the struct.
+ */
+struct ficlDictionary
+{
+    ficlCell *here;
+    void *context; /* for your use, particularly with ficlDictionaryLock() */
+    ficlWord *smudge;
+    ficlHash *forthWordlist;
+    ficlHash *compilationWordlist;
+    ficlHash *wordlists[FICL_MAX_WORDLISTS];
+    int wordlistCount;
+    unsigned size;		/* Number of cells in dictionary (total) */
+    ficlSystem *system;		/* used for debugging */
+    ficlCell base[1];		/* Base of dictionary memory */
+};
+
+FICL_PLATFORM_EXTERN void
+ficlDictionaryAbortDefinition(ficlDictionary *dictionary);
+FICL_PLATFORM_EXTERN void ficlDictionaryAlign(ficlDictionary *dictionary);
+FICL_PLATFORM_EXTERN void
+ficlDictionaryAllot(ficlDictionary *dictionary, int n);
+FICL_PLATFORM_EXTERN void
+ficlDictionaryAllotCells(ficlDictionary *dictionary, int nCells);
+FICL_PLATFORM_EXTERN void
+ficlDictionaryAppendCell(ficlDictionary *dictionary, ficlCell c);
+FICL_PLATFORM_EXTERN void
+ficlDictionaryAppendCharacter(ficlDictionary *dictionary, char c);
+FICL_PLATFORM_EXTERN void
+ficlDictionaryAppendUnsigned(ficlDictionary *dictionary, ficlUnsigned u);
+FICL_PLATFORM_EXTERN void *
+ficlDictionaryAppendData(ficlDictionary *dictionary, void *data,
+    ficlInteger length);
+FICL_PLATFORM_EXTERN char *
+ficlDictionaryAppendString(ficlDictionary *dictionary, ficlString s);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryAppendWord(ficlDictionary *dictionary, ficlString name,
+    ficlPrimitive pCode, ficlUnsigned8 flags);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryAppendPrimitive(ficlDictionary *dictionary, char *name,
+    ficlPrimitive pCode, ficlUnsigned8 flags);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryAppendInstruction(ficlDictionary *dictionary, char *name,
+    ficlInstruction i, ficlUnsigned8 flags);
+
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryAppendConstantInstruction(ficlDictionary *dictionary,
+    ficlString name, ficlInstruction instruction, ficlInteger value);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryAppend2ConstantInstruction(ficlDictionary *dictionary,
+    ficlString name, ficlInstruction instruction, ficl2Integer value);
+
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryAppendConstant(ficlDictionary *dictionary, char *name,
+    ficlInteger value);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryAppend2Constant(ficlDictionary *dictionary, char *name,
+    ficl2Integer value);
+#define	ficlDictionaryAppendConstantPointer(dictionary, name, pointer)	\
+	(ficlDictionaryAppendConstant(dictionary, name, (ficlInteger)pointer))
+#if FICL_WANT_FLOAT
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryAppendFConstant(ficlDictionary *dictionary, char *name,
+    ficlFloat value);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryAppendF2Constant(ficlDictionary *dictionary, char *name,
+    ficlFloat value);
+#endif /* FICL_WANT_FLOAT */
+
+
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionarySetConstantInstruction(ficlDictionary *dictionary,
+    ficlString name, ficlInstruction instruction, ficlInteger value);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionarySet2ConstantInstruction(ficlDictionary *dictionary,
+    ficlString name, ficlInstruction instruction, ficl2Integer value);
+
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionarySetConstant(ficlDictionary *dictionary, char *name,
+    ficlInteger value);
+#define	ficlDictionarySetConstantPointer(dictionary, name, pointer) \
+	(ficlDictionarySetConstant(dictionary, name, (ficlInteger)pointer))
+
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionarySet2Constant(ficlDictionary *dictionary, char *name,
+    ficl2Integer value);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionarySetConstantString(ficlDictionary *dictionary, char *name,
+    char *value);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionarySetPrimitive(ficlDictionary *dictionary, char *name,
+    ficlPrimitive code, ficlUnsigned8 flags);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionarySetInstruction(ficlDictionary *dictionary, char *name,
+    ficlInstruction i, ficlUnsigned8 flags);
+#if FICL_WANT_FLOAT
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionarySetFConstant(ficlDictionary *dictionary, char *name,
+    ficlFloat value);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionarySetF2Constant(ficlDictionary *dictionary, char *name,
+    ficlFloat value);
+#endif /* FICL_WANT_FLOAT */
+
+FICL_PLATFORM_EXTERN int
+ficlDictionaryCellsAvailable(ficlDictionary *dictionary);
+FICL_PLATFORM_EXTERN int ficlDictionaryCellsUsed(ficlDictionary *dictionary);
+FICL_PLATFORM_EXTERN ficlDictionary *
+ficlDictionaryCreate(ficlSystem *system, unsigned nCELLS);
+FICL_PLATFORM_EXTERN ficlDictionary *
+ficlDictionaryCreateHashed(ficlSystem *system, unsigned nCells, unsigned nHash);
+FICL_PLATFORM_EXTERN ficlHash *
+ficlDictionaryCreateWordlist(ficlDictionary *dictionary, int nBuckets);
+FICL_PLATFORM_EXTERN void ficlDictionaryDestroy(ficlDictionary *dictionary);
+FICL_PLATFORM_EXTERN void
+ficlDictionaryEmpty(ficlDictionary *dictionary, unsigned nHash);
+FICL_PLATFORM_EXTERN int
+ficlDictionaryIncludes(ficlDictionary *dictionary, void *p);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryLookup(ficlDictionary *dictionary, ficlString name);
+FICL_PLATFORM_EXTERN void
+ficlDictionaryResetSearchOrder(ficlDictionary *dictionary);
+FICL_PLATFORM_EXTERN void
+ficlDictionarySetFlags(ficlDictionary *dictionary, ficlUnsigned8 set);
+FICL_PLATFORM_EXTERN void
+ficlDictionaryClearFlags(ficlDictionary *dictionary, ficlUnsigned8 clear);
+FICL_PLATFORM_EXTERN void
+ficlDictionarySetImmediate(ficlDictionary *dictionary);
+FICL_PLATFORM_EXTERN void
+ficlDictionaryUnsmudge(ficlDictionary *dictionary);
+FICL_PLATFORM_EXTERN ficlCell *ficlDictionaryWhere(ficlDictionary *dictionary);
+
+FICL_PLATFORM_EXTERN int
+ficlDictionaryIsAWord(ficlDictionary *dictionary, ficlWord *word);
+FICL_PLATFORM_EXTERN void
+ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word,
+    ficlCallback *callback);
+FICL_PLATFORM_EXTERN ficlWord *
+ficlDictionaryFindEnclosingWord(ficlDictionary *dictionary, ficlCell *cell);
+
+/*
+ * Stub function for dictionary access control - does nothing
+ * by default, user can redefine to guarantee exclusive dictionary
+ * access to a single thread for updates. All dictionary update code
+ * must be bracketed as follows:
+ * ficlLockDictionary(dictionary, FICL_TRUE); // any non-zero value will do
+ * <code that updates dictionary>
+ * ficlLockDictionary(dictionary, FICL_FALSE);
+ *
+ * Returns zero if successful, nonzero if unable to acquire lock
+ * before timeout (optional - could also block forever)
+ *
+ * NOTE: this function must be implemented with lock counting
+ * semantics: nested calls must behave properly.
+ */
+#if FICL_MULTITHREAD
+FICL_PLATFORM_EXTERN int
+	ficlDictionaryLock(ficlDictionary *dictionary, short lockIncrement);
+#else
+#define	ficlDictionaryLock(dictionary, lock) (void)0 /* ignore */
+#endif
+
+/*
+ * P A R S E   S T E P
+ * (New for 2.05)
+ * See words.c: interpWord
+ * By default, Ficl goes through two attempts to parse each token from its
+ * input stream: it first attempts to match it with a word in the dictionary,
+ * and if that fails, it attempts to convert it into a number. This mechanism
+ * is now extensible by additional steps. This allows extensions like floating
+ * point and double number support to be factored cleanly.
+ *
+ * Each parse step is a function that receives the next input token as a
+ * STRINGINFO. If the parse step matches the token, it must apply semantics
+ * to the token appropriate to the present value of VM.state (compiling or
+ * interpreting), and return FICL_TRUE.
+ * Otherwise it returns FICL_FALSE. See words.c: isNumber for an example
+ *
+ * Note: for the sake of efficiency, it's a good idea both to limit the number
+ * of parse steps and to code each parse step so that it rejects tokens that
+ * do not match as quickly as possible.
+ */
+
+typedef int (*ficlParseStep)(ficlVm *vm, ficlString s);
+
+/*
+ * FICL_BREAKPOINT record.
+ * oldXT - 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
+ * oldXT  - The original contents of the location with the breakpoint
+ * Note: address is NULL when this breakpoint is empty
+ */
+typedef struct ficlBreakpoint
+{
+	void *address;
+	ficlWord *oldXT;
+} ficlBreakpoint;
+
+
+/*
+ * 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 added
+ * support for multiple Ficl systems, allowing multiple concurrent sessions
+ * to separate dictionaries with some constraints.
+ * Note: the context pointer is there to provide context for applications.
+ * It is copied to each VM's context field as that VM is created.
+ */
+struct ficlSystemInformation
+{
+    int size;			/* structure size tag for versioning */
+		/* Initializes VM's context pointer - for application use */
+    void *context;
+    int dictionarySize;		/* Size of system's Dictionary, in cells */
+    int stackSize;		/* Size of all stacks created, in cells */
+    ficlOutputFunction textOut;		/* default textOut function */
+    ficlOutputFunction errorOut;	/* textOut function used for errors */
+    int environmentSize;	/* Size of Environment dictionary, in cells */
+};
+
+#define	ficlSystemInformationInitialize(x)	\
+	{ memset((x), 0, sizeof (ficlSystemInformation)); \
+	(x)->size = sizeof (ficlSystemInformation); }
+
+struct ficlSystem
+{
+    ficlCallback callback;
+    ficlSystem *link;
+    ficlVm *vmList;
+    ficlDictionary *dictionary;
+    ficlDictionary *environment;
+
+    ficlWord *interpreterLoop[3];
+    ficlWord *parseList[FICL_MAX_PARSE_STEPS];
+
+    ficlWord *exitInnerWord;
+    ficlWord *interpretWord;
+
+#if FICL_WANT_LOCALS
+    ficlDictionary *locals;
+    ficlInteger   localsCount;
+    ficlCell *localsFixup;
+#endif
+
+    ficlInteger stackSize;
+
+    ficlBreakpoint breakpoint;
+};
+
+#define	ficlSystemGetContext(system)	((system)->context)
+
+/*
+ * External interface to Ficl...
+ */
+/*
+ * f i c l S y s t e m C r e a t e
+ * Binds a global dictionary to the interpreter system and initializes
+ * the dictionary to contain the ANSI CORE wordset.
+ * You can specify the address and size of the allocated area.
+ * You can also specify the text output function at creation time.
+ * After that, Ficl manages it.
+ * First step is to set up the static pointers to the area.
+ * Then write the "precompiled" portion of the dictionary in.
+ * The dictionary needs to be at least large enough to hold the
+ * precompiled part. Try 1K cells minimum. Use "words" to find
+ * out how much of the dictionary is used at any time.
+ */
+FICL_PLATFORM_EXTERN ficlSystem *ficlSystemCreate(ficlSystemInformation *fsi);
+
+/*
+ * f i c l S y s t e m D e s t r o y
+ * Deletes the system dictionary and all virtual machines that
+ * were created with ficlNewVM (see below). Call this function to
+ * reclaim all memory used by the dictionary and VMs.
+ */
+FICL_PLATFORM_EXTERN void ficlSystemDestroy(ficlSystem *system);
+
+/*
+ * Create a new VM from the heap, and link it into the system VM list.
+ * Initializes the VM and binds default sized stacks to it. Returns the
+ * address of the VM, or NULL if an error occurs.
+ * Precondition: successful execution of ficlInitSystem
+ */
+FICL_PLATFORM_EXTERN ficlVm   *ficlSystemCreateVm(ficlSystem *system);
+
+/*
+ * Force deletion of a VM. You do not need to do this
+ * unless you're creating and discarding a lot of VMs.
+ * For systems that use a constant pool of VMs for the life
+ * of the system, ficltermSystem takes care of VM cleanup
+ * automatically.
+ */
+FICL_PLATFORM_EXTERN void ficlSystemDestroyVm(ficlVm *vm);
+
+
+/*
+ * Returns the address of the most recently defined word in the system
+ * dictionary with the given name, or NULL if no match.
+ * Precondition: successful execution of ficlInitSystem
+ */
+FICL_PLATFORM_EXTERN ficlWord *ficlSystemLookup(ficlSystem *system, 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
+ */
+ficlDictionary *ficlSystemGetDictionary(ficlSystem *system);
+ficlDictionary *ficlSystemGetEnvironment(ficlSystem *system);
+#if FICL_WANT_LOCALS
+ficlDictionary *ficlSystemGetLocals(ficlSystem *system);
+#endif
+
+/*
+ * f i c l C o m p i l e C o r e
+ * Builds the ANS CORE wordset into the dictionary - called by
+ * ficlInitSystem - no need to waste dictionary space by doing it again.
+ */
+FICL_PLATFORM_EXTERN void ficlSystemCompileCore(ficlSystem *system);
+FICL_PLATFORM_EXTERN void ficlSystemCompilePrefix(ficlSystem *system);
+FICL_PLATFORM_EXTERN void ficlSystemCompileSearch(ficlSystem *system);
+FICL_PLATFORM_EXTERN void ficlSystemCompileSoftCore(ficlSystem *system);
+FICL_PLATFORM_EXTERN void ficlSystemCompileTools(ficlSystem *system);
+FICL_PLATFORM_EXTERN void ficlSystemCompileFile(ficlSystem *system);
+#if FICL_WANT_FLOAT
+FICL_PLATFORM_EXTERN void ficlSystemCompileFloat(ficlSystem *system);
+FICL_PLATFORM_EXTERN int ficlVmParseFloatNumber(ficlVm *vm, ficlString s);
+#endif /* FICL_WANT_FLOAT */
+#if FICL_WANT_PLATFORM
+FICL_PLATFORM_EXTERN void ficlSystemCompilePlatform(ficlSystem *system);
+#endif /* FICL_WANT_PLATFORM */
+FICL_PLATFORM_EXTERN void ficlSystemCompileExtras(ficlSystem *system);
+
+
+FICL_PLATFORM_EXTERN int ficlVmParsePrefix(ficlVm *vm, ficlString s);
+
+#if FICL_WANT_LOCALS
+FICL_PLATFORM_EXTERN ficlWord *ficlSystemLookupLocal(ficlSystem *system,
+    ficlString name);
+#endif
+
+/*
+ * from words.c...
+ */
+FICL_PLATFORM_EXTERN int ficlVmParseNumber(ficlVm *vm, ficlString s);
+FICL_PLATFORM_EXTERN void ficlPrimitiveTick(ficlVm *vm);
+FICL_PLATFORM_EXTERN void ficlPrimitiveParseStepParen(ficlVm *vm);
+#if FICL_WANT_LOCALS
+FICL_PLATFORM_EXTERN void ficlLocalParen(ficlVm *vm, int isDouble, int isFloat);
+#endif /* FICL_WANT_LOCALS */
+
+/*
+ * Appends a parse step function to the end of the parse list (see
+ * FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful,
+ * nonzero if there's no more room in the list. Each parse step is a word in
+ * the dictionary. Precompiled parse steps can use (PARSE-STEP) as their
+ * CFA - see parenParseStep in words.c.
+ */
+FICL_PLATFORM_EXTERN int ficlSystemAddParseStep(ficlSystem *system,
+    ficlWord *word); /* ficl.c */
+FICL_PLATFORM_EXTERN void ficlSystemAddPrimitiveParseStep(ficlSystem *system,
+    char *name, ficlParseStep pStep);
+
+/*
+ * From tools.c
+ */
+
+/*
+ * The following supports SEE and the debugger.
+ */
+typedef enum
+{
+    FICL_WORDKIND_BRANCH,
+    FICL_WORDKIND_BRANCH0,
+    FICL_WORDKIND_COLON,
+    FICL_WORDKIND_CONSTANT,
+    FICL_WORDKIND_2CONSTANT,
+    FICL_WORDKIND_CREATE,
+    FICL_WORDKIND_DO,
+    FICL_WORDKIND_DOES,
+    FICL_WORDKIND_LITERAL,
+    FICL_WORDKIND_2LITERAL,
+#if FICL_WANT_FLOAT
+    FICL_WORDKIND_FLITERAL,
+#endif /* FICL_WANT_FLOAT */
+    FICL_WORDKIND_LOOP,
+    FICL_WORDKIND_OF,
+    FICL_WORDKIND_PLOOP,
+    FICL_WORDKIND_PRIMITIVE,
+    FICL_WORDKIND_QDO,
+    FICL_WORDKIND_STRING_LITERAL,
+    FICL_WORDKIND_CSTRING_LITERAL,
+#if FICL_WANT_USER
+    FICL_WORDKIND_USER,
+#endif
+    FICL_WORDKIND_VARIABLE,
+    FICL_WORDKIND_INSTRUCTION,
+    FICL_WORDKIND_INSTRUCTION_WORD,
+    FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT
+} ficlWordKind;
+
+ficlWordKind   ficlWordClassify(ficlWord *word);
+
+#if FICL_WANT_FILE
+/*
+ * 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))
+
+typedef struct ficlFile
+{
+    FILE *f;
+    char filename[256];
+} ficlFile;
+
+#if defined(FICL_PLATFORM_HAS_FTRUNCATE)
+FICL_PLATFORM_EXTERN int ficlFileTruncate(ficlFile *ff, ficlUnsigned size);
+#endif
+
+FICL_PLATFORM_EXTERN int ficlFileStatus(char *filename, int *status);
+FICL_PLATFORM_EXTERN long ficlFileSize(ficlFile *ff);
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _FICL_H */
diff --git a/usr/src/common/ficl/ficlplatform/emu.h b/usr/src/common/ficl/ficlplatform/emu.h
new file mode 100644
index 0000000000..ff969d34f9
--- /dev/null
+++ b/usr/src/common/ficl/ficlplatform/emu.h
@@ -0,0 +1,36 @@
+/*
+ * This file and its contents are supplied under the terms of the
+ * Common Development and Distribution License ("CDDL"), version 1.0.
+ * You may only use this file in accordance with the terms of version
+ * 1.0 of the CDDL.
+ *
+ * A full copy of the text of the CDDL should have accompanied this
+ * source.  A copy of the CDDL is also available via the Internet at
+ * http://www.illumos.org/license/CDDL.
+ */
+
+/*
+ * Copyright 2015 Toomas Soome <tsoome@me.com>
+ */
+
+#ifndef _FICLPLATFORM_EMU_H
+#define	_FICLPLATFORM_EMU_H
+
+/*
+ * BootForth Emulator entry points.
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern ficlVm *bf_init(const char *, ficlOutputFunction);
+extern void bf_fini(void);
+extern int bf_run(char *);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _FICLPLATFORM_EMU_H */
diff --git a/usr/src/common/ficl/ficlplatform/pager.c b/usr/src/common/ficl/ficlplatform/pager.c
new file mode 100644
index 0000000000..f297945dbb
--- /dev/null
+++ b/usr/src/common/ficl/ficlplatform/pager.c
@@ -0,0 +1,182 @@
+/*
+ * Copyright (c) 1998 Michael Smith <msmith@freebsd.org>
+ * All rights reserved.
+ *
+ * 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.
+ */
+/*
+ * Simple paged-output and paged-viewing functions
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <termios.h>
+#include <unistd.h>
+#include <stropts.h>
+
+static int p_maxlines = -1;
+static int p_freelines;
+
+static struct termios orig_termios;
+static char *pager_prompt1 = \
+	" --more--  <space> page down <enter> line down <q> quit ";
+static char *pager_blank = \
+	"                                                        ";
+
+/*
+ * 'open' the pager
+ */
+void
+pager_open(void)
+{
+	int	nlines;
+	char *cp, *lp;
+	struct termios raw;
+	struct winsize ws;
+
+	tcgetattr(0, &orig_termios);
+	raw = orig_termios;
+	raw.c_lflag &= ~(ICANON | ECHO);
+	raw.c_cc[VMIN] = 1;
+	raw.c_cc[VTIME] = 0;
+	(void) tcsetattr(0, TCSAFLUSH, &raw);
+
+	nlines = 24;		/* sensible default */
+	if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_row == 0) {
+		if ((cp = getenv("LINES")) != NULL) {
+			nlines = strtol(cp, &lp, 0);
+		}
+	} else
+		nlines = ws.ws_row;
+
+	p_maxlines = nlines - 1;
+	if (p_maxlines < 1)
+		p_maxlines = 1;
+	p_freelines = p_maxlines;
+}
+
+/*
+ * 'close' the pager
+ */
+void
+pager_close(void)
+{
+	(void) fflush(stdout);
+	p_maxlines = -1;
+	(void) tcsetattr(0, TCSAFLUSH, &orig_termios);
+}
+
+/*
+ * Emit lines to the pager; may not return until the user
+ * has responded to the prompt.
+ *
+ * Will return nonzero if the user enters 'q' or 'Q' at the prompt.
+ *
+ * XXX note that this watches outgoing newlines (and eats them), but
+ *     does not handle wrap detection (req. count of columns).
+ */
+int
+pager_output(const char *cp)
+{
+	int action;
+
+	if (cp == NULL)
+		return (0);
+
+	for (;;) {
+		if (*cp == 0)
+			return (0);
+
+		putchar(*cp);		/* always emit character */
+
+		if (*(cp++) == '\n') {	/* got a newline? */
+			p_freelines--;
+			if (p_freelines <= 0) {
+				printf("%s", pager_prompt1);
+				action = 0;
+				while (action == 0) {
+					switch (getchar()) {
+					case '\r':
+					case '\n':
+						p_freelines = 1;
+						action = 1;
+					break;
+					case ' ':
+						p_freelines = p_maxlines;
+						action = 1;
+					break;
+					case 'q':
+					case 'Q':
+						action = 2;
+					break;
+					default:
+					break;
+					}
+				}
+				printf("\r%s\r", pager_blank);
+				if (action == 2)
+					return (1);
+			}
+		}
+	}
+}
+
+/*
+ * Display from (fd).
+ */
+int
+pager_file(const char *fname)
+{
+	char buf[80];
+	size_t hmuch;
+	int fd;
+	int result;
+
+	if ((fd = open(fname, O_RDONLY)) == -1) {
+		printf("can't open '%s': %s\n", fname, strerror(errno));
+		return (-1);
+	}
+
+	for (;;) {
+		hmuch = read(fd, buf, sizeof (buf) - 1);
+		if (hmuch == -1) {
+			result = -1;
+			break;
+		}
+		if (hmuch == 0) {
+			result = 0;
+			break;
+		}
+		buf[hmuch] = 0;
+		if (pager_output(buf)) {
+			result = 1;
+			break;
+		}
+	}
+	close(fd);
+	return (result);
+}
diff --git a/usr/src/common/ficl/ficlplatform/unix.c b/usr/src/common/ficl/ficlplatform/unix.c
new file mode 100644
index 0000000000..ac49de5c2f
--- /dev/null
+++ b/usr/src/common/ficl/ficlplatform/unix.c
@@ -0,0 +1,86 @@
+/*
+ * This file and its contents are supplied under the terms of the
+ * Common Development and Distribution License ("CDDL"), version 1.0.
+ * You may only use this file in accordance with the terms of version
+ * 1.0 of the CDDL.
+ *
+ * A full copy of the text of the CDDL should have accompanied this
+ * source.  A copy of the CDDL is also available via the Internet at
+ * http://www.illumos.org/license/CDDL.
+ */
+
+/*
+ * Copyright 2015 Toomas Soome <tsoome@me.com>
+ */
+
+#include "ficl.h"
+
+void *
+ficlMalloc(size_t size)
+{
+	return (malloc(size));
+}
+
+void *
+ficlRealloc(void *p, size_t size)
+{
+	return (realloc(p, size));
+}
+
+void
+ficlFree(void *p)
+{
+	free(p);
+}
+
+void
+ficlCallbackDefaultTextOut(ficlCallback *callback, char *message)
+{
+	FICL_IGNORE(callback);
+
+	if (message != NULL) {
+#ifdef STAND
+		while (*message != 0)
+			putchar((unsigned char)*(message++));
+#else
+		(void) fputs(message, stdout);
+		(void) fflush(stdout);
+#endif
+	}
+}
+
+#if FICL_WANT_FILE
+int
+ficlFileTruncate(ficlFile *ff, ficlUnsigned size)
+{
+	return (ftruncate(fileno(ff->f), size));
+}
+
+int
+ficlFileStatus(char *filename, int *status)
+{
+	struct stat statbuf;
+
+	if (stat(filename, &statbuf) == 0) {
+		*status = statbuf.st_mode;
+		return (0);
+	}
+	*status = ENOENT;
+	return (-1);
+}
+
+long
+ficlFileSize(ficlFile *ff)
+{
+	struct stat statbuf;
+
+	if (ff == NULL)
+		return (-1);
+
+	statbuf.st_size = -1;
+	if (fstat(fileno(ff->f), &statbuf) != 0)
+		return (-1);
+
+	return (statbuf.st_size);
+}
+#endif
diff --git a/usr/src/common/ficl/ficlplatform/unix.h b/usr/src/common/ficl/ficlplatform/unix.h
new file mode 100644
index 0000000000..75691a898f
--- /dev/null
+++ b/usr/src/common/ficl/ficlplatform/unix.h
@@ -0,0 +1,77 @@
+/*
+ * This file and its contents are supplied under the terms of the
+ * Common Development and Distribution License ("CDDL"), version 1.0.
+ * You may only use this file in accordance with the terms of version
+ * 1.0 of the CDDL.
+ *
+ * A full copy of the text of the CDDL should have accompanied this
+ * source.  A copy of the CDDL is also available via the Internet at
+ * http://www.illumos.org/license/CDDL.
+ */
+
+/*
+ * Copyright 2015 Toomas Soome <tsoome@me.com>
+ */
+
+#ifndef _UNIX_H
+#define	_UNIX_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define	FICL_WANT_PLATFORM (1)
+
+#define	FICL_PLATFORM_OS		"Illumos"
+#ifdef __sparc
+#define	FICL_PLATFORM_ARCHITECTURE	"sparc"
+#else
+#define	FICL_PLATFORM_ARCHITECTURE	"i386"
+#endif
+
+#define	FICL_PLATFORM_BASIC_TYPES	(1)
+#if defined(_LP64)
+#define	FICL_PLATFORM_ALIGNMENT		(8)
+#else
+#define	FICL_PLATFORM_ALIGNMENT		(4)
+#endif
+#define	FICL_PLATFORM_INLINE		inline
+
+#define	FICL_PLATFORM_HAS_FTRUNCATE	(1)
+#if defined(_LP64)
+#define	FICL_PLATFORM_HAS_2INTEGER	(0)
+#else
+#define	FICL_PLATFORM_HAS_2INTEGER	(1)
+#endif
+
+typedef int8_t ficlInteger8;
+typedef uint8_t ficlUnsigned8;
+typedef int16_t ficlInteger16;
+typedef uint16_t ficlUnsigned16;
+typedef int32_t ficlInteger32;
+typedef uint32_t ficlUnsigned32;
+typedef int64_t ficlInteger64;
+typedef uint64_t ficlUnsigned64;
+
+#if defined(_LP64)
+typedef ficlInteger64 ficlInteger;
+typedef ficlUnsigned64 ficlUnsigned;
+
+typedef double ficlFloat;
+#else /* default */
+typedef ficlInteger32 ficlInteger;
+typedef ficlUnsigned32 ficlUnsigned;
+
+typedef float ficlFloat;
+#endif
+
+#if defined(FICL_PLATFORM_HAS_2INTEGER) && FICL_PLATFORM_HAS_2INTEGER
+typedef ficlInteger64 ficl2Integer;
+typedef ficlUnsigned64 ficl2Unsigned;
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _UNIX_H */
diff --git a/usr/src/common/ficl/ficltokens.h b/usr/src/common/ficl/ficltokens.h
new file mode 100644
index 0000000000..4a568ede40
--- /dev/null
+++ b/usr/src/common/ficl/ficltokens.h
@@ -0,0 +1,269 @@
+FICL_TOKEN(ficlInstructionInvalid, "** invalid **")
+FICL_TOKEN(ficlInstruction1, "1")
+FICL_TOKEN(ficlInstruction2, "2")
+FICL_TOKEN(ficlInstruction3, "3")
+FICL_TOKEN(ficlInstruction4, "4")
+FICL_TOKEN(ficlInstruction5, "5")
+FICL_TOKEN(ficlInstruction6, "6")
+FICL_TOKEN(ficlInstruction7, "7")
+FICL_TOKEN(ficlInstruction8, "8")
+FICL_TOKEN(ficlInstruction9, "9")
+FICL_TOKEN(ficlInstruction10, "10")
+FICL_TOKEN(ficlInstruction11, "11")
+FICL_TOKEN(ficlInstruction12, "12")
+FICL_TOKEN(ficlInstruction13, "13")
+FICL_TOKEN(ficlInstruction14, "14")
+FICL_TOKEN(ficlInstruction15, "15")
+FICL_TOKEN(ficlInstruction16, "16")
+FICL_TOKEN(ficlInstruction0, "0")
+FICL_TOKEN(ficlInstructionNeg1, "-1")
+FICL_TOKEN(ficlInstructionNeg2, "-2")
+FICL_TOKEN(ficlInstructionNeg3, "-3")
+FICL_TOKEN(ficlInstructionNeg4, "-4")
+FICL_TOKEN(ficlInstructionNeg5, "-5")
+FICL_TOKEN(ficlInstructionNeg6, "-6")
+FICL_TOKEN(ficlInstructionNeg7, "-7")
+FICL_TOKEN(ficlInstructionNeg8, "-8")
+FICL_TOKEN(ficlInstructionNeg9, "-9")
+FICL_TOKEN(ficlInstructionNeg10, "-10")
+FICL_TOKEN(ficlInstructionNeg11, "-11")
+FICL_TOKEN(ficlInstructionNeg12, "-12")
+FICL_TOKEN(ficlInstructionNeg13, "-13")
+FICL_TOKEN(ficlInstructionNeg14, "-14")
+FICL_TOKEN(ficlInstructionNeg15, "-15")
+FICL_TOKEN(ficlInstructionNeg16, "-16")
+#if FICL_WANT_FLOAT
+FICL_TOKEN(ficlInstructionF0, "0.0e")
+FICL_TOKEN(ficlInstructionF1, "1.0e")
+FICL_TOKEN(ficlInstructionFNeg1, "-1.0e")
+#endif /* FICL_WANT_FLOAT */
+FICL_INSTRUCTION_TOKEN(ficlInstructionPlus, "+", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionMinus, "-", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction1Plus, "1+", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction1Minus, "1-", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Plus, "2+", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Minus, "2-", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionSemiParen, "(;)", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionExitParen, "(exit)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionDup, "dup", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionSwap, "swap", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionGreaterThan, ">", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionBranchParenWithCheck, "(branch)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionBranchParen, "(branch-final)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionBranch0ParenWithCheck, "(branch0)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionBranch0Paren, "(branch0-final)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionLiteralParen, "(literal)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionLoopParen, "(loop)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionOfParen, "(of)", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionPlusLoopParen, "(+loop)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFetch, "@", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionStore, "!", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionComma, ",", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionCComma, "c,", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionCells, "cells", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionCellPlus, "cell+", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionNegate, "negate", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionStar, "*", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionSlash, "/", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionStarSlash, "*/", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionSlashMod, "/mod", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionStarSlashMod, "*/mod", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Star, "2*", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Slash, "2/", FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionColonParen, "** (colon) **",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionVariableParen, "(variable)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionConstantParen, "(constant)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2ConstantParen, "(2constant)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2LiteralParen, "(2literal)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionDoDoes, "** do-does **",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionDoParen, "(do)", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionDoesParen, "(does)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionQDoParen, "(?do)", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionCreateParen, "(create)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionStringLiteralParen, "(.\")",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionCStringLiteralParen, "(c\")",
+    FICL_WORD_COMPILE_ONLY)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionPlusStore, "+!", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction0Less, "0<", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction0Greater, "0>", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction0Equals, "0=", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Store, "2!", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Fetch, "2@", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionOver, "over", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionRot, "rot", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Drop, "2drop", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Dup, "2dup", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Over, "2over", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2Swap, "2swap", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFromRStack, "r>", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFetchRStack, "r@", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2ToR, "2>r", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2RFrom, "2r>", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstruction2RFetch, "2r@", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionLess, "<", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionEquals, "=", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionToRStack, ">r", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionQuestionDup, "?dup", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionAnd, "and", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionCStore, "c!", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionCFetch, "c@", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionDrop, "drop", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionPick, "pick", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionRoll, "roll", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionMinusRoll, "-roll", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionMinusRot, "-rot", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFill, "fill", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionSToD, "s>d", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionULess, "u<", FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionQuadFetch, "q@", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionQuadStore, "q!", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionWFetch, "w@", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionWStore, "w!", FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionInvert, "invert", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionLShift, "lshift", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionMax, "max", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionMin, "min", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionMove, "move", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionOr, "or", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionRShift, "rshift", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionXor, "xor", FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionI, "i", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionJ, "j", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionK, "k", FICL_WORD_COMPILE_ONLY)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionCompare, "compare", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionCompareInsensitive, "compare-insensitive",
+    FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionRandom, "random", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionSeedRandom, "seed-random",
+    FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionLeave, "leave", FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionUnloop, "unloop", FICL_WORD_COMPILE_ONLY)
+
+#if FICL_WANT_USER
+FICL_INSTRUCTION_TOKEN(ficlInstructionUserParen, "(user)", FICL_WORD_DEFAULT)
+#endif /* FICL_WANT_USER */
+
+#if FICL_WANT_LOCALS
+FICL_INSTRUCTION_TOKEN(ficlInstructionLinkParen, "(link)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionUnlinkParen, "(unlink)",
+    FICL_WORD_COMPILE_ONLY)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionGetLocalParen, "(@local)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionGet2LocalParen, "(@2Local)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionToLocalParen, "(toLocal)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionTo2LocalParen, "(to2Local)",
+    FICL_WORD_COMPILE_ONLY)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionGetLocal0, "(@local0)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionGet2Local0, "(@2Local0)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionToLocal0, "(toLocal0)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionTo2Local0, "(To2Local0)",
+    FICL_WORD_COMPILE_ONLY)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionGetLocal1, "(@local1)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionToLocal1, "(toLocal1)",
+    FICL_WORD_COMPILE_ONLY)
+
+#if FICL_WANT_FLOAT
+FICL_INSTRUCTION_TOKEN(ficlInstructionGetFLocalParen, "(@fLocal)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionGetF2LocalParen, "(@f2Local)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionToFLocalParen, "(toFLocal)",
+    FICL_WORD_COMPILE_ONLY)
+FICL_INSTRUCTION_TOKEN(ficlInstructionToF2LocalParen, "(toF2Local)",
+    FICL_WORD_COMPILE_ONLY)
+#endif /* FICL_WANT_FLOAT */
+
+#endif /* FICL_WANT_LOCALS */
+
+#if FICL_WANT_FLOAT
+FICL_INSTRUCTION_TOKEN(ficlInstructionFLiteralParen, "(fliteral)",
+    FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFConstantParen, "(fconstant)",
+    FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionF2ConstantParen, "(f2constant)",
+    FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionFPlus, "f+", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFMinus, "f-", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFStar, "f*", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFSlash, "f/", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFNegate, "fnegate", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFPlusI, "f+i", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFMinusI, "f-i", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFStarI, "f*i", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFSlashI, "f/i", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionIMinusF, "i-f", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionISlashF, "i/f", FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionFFrom, "float>", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionToF, ">float", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionIntToFloat, "int>float",
+    FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFloatToInt, "float>int",
+    FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionFFetch, "f@", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFStore, "f!", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionF2Fetch, "f2@", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionF2Store, "f2!", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFPlusStore, "f+!", FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionFDrop, "fdrop", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionF2Drop, "f2drop", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFDup, "fdup", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionF2Dup, "f2dup", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFMinusRoll, "f-roll", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFMinusRot, "f-rot", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFQuestionDup, "f?dup", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFOver, "fover", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionF2Over, "f2over", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFPick, "fpick", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFRoll, "froll", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFRot, "frot", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFSwap, "fswap", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionF2Swap, "f2swap", FICL_WORD_DEFAULT)
+
+FICL_INSTRUCTION_TOKEN(ficlInstructionF0Less, "f0<", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFLess, "f<", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionF0Equals, "f0=", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFEquals, "f=", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionF0Greater, "f0>", FICL_WORD_DEFAULT)
+FICL_INSTRUCTION_TOKEN(ficlInstructionFGreater, "f>", FICL_WORD_DEFAULT)
+
+#endif  /* FICL_WANT_FLOAT */
+
+FICL_TOKEN(ficlInstructionExitInnerLoop, "** exit inner loop **")
diff --git a/usr/src/common/ficl/fileaccess.c b/usr/src/common/ficl/fileaccess.c
new file mode 100644
index 0000000000..37814eae1c
--- /dev/null
+++ b/usr/src/common/ficl/fileaccess.c
@@ -0,0 +1,400 @@
+#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(ficlVm *vm, int success)
+{
+	int ior;
+	if (success)
+		ior = 0;
+	else
+		ior = errno;
+	ficlStackPushInteger(vm->dataStack, ior);
+}
+
+/* ( c-addr u fam -- fileid ior ) */
+static void
+ficlFileOpen(ficlVm *vm, char *writeMode)
+{
+	int fam = ficlStackPopInteger(vm->dataStack);
+	int length = ficlStackPopInteger(vm->dataStack);
+	void *address = (void *)ficlStackPopPointer(vm->dataStack);
+	char mode[4];
+	FILE *f;
+	char *filename = (char *)malloc(length + 1);
+	memcpy(filename, address, length);
+	filename[length] = 0;
+
+	*mode = 0;
+
+	switch (FICL_FAM_OPEN_MODE(fam)) {
+	case 0:
+		ficlStackPushPointer(vm->dataStack, NULL);
+		ficlStackPushInteger(vm->dataStack, EINVAL);
+	goto EXIT;
+	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)
+		ficlStackPushPointer(vm->dataStack, NULL);
+	else {
+		ficlFile *ff = (ficlFile *)malloc(sizeof (ficlFile));
+		strcpy(ff->filename, filename);
+		ff->f = f;
+		ficlStackPushPointer(vm->dataStack, ff);
+
+		fseek(f, 0, SEEK_SET);
+	}
+	pushIor(vm, f != NULL);
+
+EXIT:
+	free(filename);
+}
+
+/* ( c-addr u fam -- fileid ior ) */
+static void
+ficlPrimitiveOpenFile(ficlVm *vm)
+{
+	ficlFileOpen(vm, "a");
+}
+
+/* ( c-addr u fam -- fileid ior ) */
+static void
+ficlPrimitiveCreateFile(ficlVm *vm)
+{
+	ficlFileOpen(vm, "w");
+}
+
+/* ( fileid -- ior ) */
+static int
+ficlFileClose(ficlFile *ff)
+{
+	FILE *f = ff->f;
+	free(ff);
+	return (!fclose(f));
+}
+
+/* ( fileid -- ior ) */
+static void
+ficlPrimitiveCloseFile(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	pushIor(vm, ficlFileClose(ff));
+}
+
+/* ( c-addr u -- ior ) */
+static void
+ficlPrimitiveDeleteFile(ficlVm *vm)
+{
+	int length = ficlStackPopInteger(vm->dataStack);
+	void *address = (void *)ficlStackPopPointer(vm->dataStack);
+
+	char *filename = (char *)malloc(length + 1);
+	memcpy(filename, address, length);
+	filename[length] = 0;
+
+	pushIor(vm, !unlink(filename));
+	free(filename);
+}
+
+/* ( c-addr1 u1 c-addr2 u2 -- ior ) */
+static void
+ficlPrimitiveRenameFile(ficlVm *vm)
+{
+	int length;
+	void *address;
+	char *from;
+	char *to;
+
+	length = ficlStackPopInteger(vm->dataStack);
+	address = (void *)ficlStackPopPointer(vm->dataStack);
+	to = (char *)malloc(length + 1);
+	memcpy(to, address, length);
+	to[length] = 0;
+
+	length = ficlStackPopInteger(vm->dataStack);
+	address = (void *)ficlStackPopPointer(vm->dataStack);
+
+	from = (char *)malloc(length + 1);
+	memcpy(from, address, length);
+	from[length] = 0;
+
+	pushIor(vm, !rename(from, to));
+
+	free(from);
+	free(to);
+}
+
+/* ( c-addr u -- x ior ) */
+static void
+ficlPrimitiveFileStatus(ficlVm *vm)
+{
+	int status;
+	int ior;
+
+	int length = ficlStackPopInteger(vm->dataStack);
+	void *address = (void *)ficlStackPopPointer(vm->dataStack);
+
+	char *filename = (char *)malloc(length + 1);
+	memcpy(filename, address, length);
+	filename[length] = 0;
+
+	ior = ficlFileStatus(filename, &status);
+	free(filename);
+
+	ficlStackPushInteger(vm->dataStack, status);
+	ficlStackPushInteger(vm->dataStack, ior);
+}
+
+/* ( fileid -- ud ior ) */
+static void
+ficlPrimitiveFilePosition(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	long ud = ftell(ff->f);
+	ficlStackPushInteger(vm->dataStack, ud);
+	pushIor(vm, ud != -1);
+}
+
+/* ( fileid -- ud ior ) */
+static void
+ficlPrimitiveFileSize(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	long ud = ficlFileSize(ff);
+	ficlStackPushInteger(vm->dataStack, ud);
+	pushIor(vm, ud != -1);
+}
+
+/* ( i*x fileid -- j*x ) */
+#define	nLINEBUF	256
+static void
+ficlPrimitiveIncludeFile(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	ficlCell id = vm->sourceId;
+	int  except = FICL_VM_STATUS_OUT_OF_TEXT;
+	long currentPosition, totalSize;
+	long size;
+	ficlString s;
+	vm->sourceId.p = (void *)ff;
+
+	currentPosition = ftell(ff->f);
+	totalSize = ficlFileSize(ff);
+	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) {
+			FICL_STRING_SET_POINTER(s, buffer);
+			FICL_STRING_SET_LENGTH(s, size);
+			except = ficlVmExecuteString(vm, s);
+		}
+	}
+
+	if ((except < 0) && (except != FICL_VM_STATUS_OUT_OF_TEXT))
+		ficlVmThrow(vm, except);
+
+	/*
+	 * Pass an empty line with SOURCE-ID == -1 to flush
+	 * any pending REFILLs (as required by FILE wordset)
+	 */
+	vm->sourceId.i = -1;
+	FICL_STRING_SET_FROM_CSTRING(s, "");
+	ficlVmExecuteString(vm, s);
+
+	vm->sourceId = id;
+	ficlFileClose(ff);
+}
+
+/* ( c-addr u1 fileid -- u2 ior ) */
+static void
+ficlPrimitiveReadFile(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	int length = ficlStackPopInteger(vm->dataStack);
+	void *address = (void *)ficlStackPopPointer(vm->dataStack);
+	int result;
+
+	clearerr(ff->f);
+	result = fread(address, 1, length, ff->f);
+
+	ficlStackPushInteger(vm->dataStack, result);
+	pushIor(vm, ferror(ff->f) == 0);
+}
+
+/* ( c-addr u1 fileid -- u2 flag ior ) */
+static void
+ficlPrimitiveReadLine(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	int length = ficlStackPopInteger(vm->dataStack);
+	char *address = (char *)ficlStackPopPointer(vm->dataStack);
+	int error;
+	int flag;
+
+	if (feof(ff->f)) {
+		ficlStackPushInteger(vm->dataStack, -1);
+		ficlStackPushInteger(vm->dataStack, 0);
+		ficlStackPushInteger(vm->dataStack, 0);
+		return;
+	}
+
+	clearerr(ff->f);
+	*address = 0;
+	fgets(address, length, ff->f);
+
+	error = ferror(ff->f);
+	if (error != 0) {
+		ficlStackPushInteger(vm->dataStack, -1);
+		ficlStackPushInteger(vm->dataStack, 0);
+		ficlStackPushInteger(vm->dataStack, error);
+		return;
+	}
+
+	length = strlen(address);
+	flag = (length > 0);
+	if (length && ((address[length - 1] == '\r') ||
+	    (address[length - 1] == '\n')))
+		length--;
+
+	ficlStackPushInteger(vm->dataStack, length);
+	ficlStackPushInteger(vm->dataStack, flag);
+	ficlStackPushInteger(vm->dataStack, 0); /* ior */
+}
+
+/* ( c-addr u1 fileid -- ior ) */
+static void
+ficlPrimitiveWriteFile(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	int length = ficlStackPopInteger(vm->dataStack);
+	void *address = (void *)ficlStackPopPointer(vm->dataStack);
+
+	clearerr(ff->f);
+	fwrite(address, 1, length, ff->f);
+	pushIor(vm, ferror(ff->f) == 0);
+}
+
+/* ( c-addr u1 fileid -- ior ) */
+static void
+ficlPrimitiveWriteLine(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	size_t length = (size_t)ficlStackPopInteger(vm->dataStack);
+	void *address = (void *)ficlStackPopPointer(vm->dataStack);
+
+	clearerr(ff->f);
+	if (fwrite(address, 1, length, ff->f) == length)
+		fwrite("\n", 1, 1, ff->f);
+	pushIor(vm, ferror(ff->f) == 0);
+}
+
+/* ( ud fileid -- ior ) */
+static void
+ficlPrimitiveRepositionFile(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	size_t ud = (size_t)ficlStackPopInteger(vm->dataStack);
+
+	pushIor(vm, fseek(ff->f, ud, SEEK_SET) == 0);
+}
+
+/* ( fileid -- ior ) */
+static void
+ficlPrimitiveFlushFile(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	pushIor(vm, fflush(ff->f) == 0);
+}
+
+#if FICL_PLATFORM_HAS_FTRUNCATE
+/* ( ud fileid -- ior ) */
+static void
+ficlPrimitiveResizeFile(ficlVm *vm)
+{
+	ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+	size_t ud = (size_t)ficlStackPopInteger(vm->dataStack);
+
+	pushIor(vm, ficlFileTruncate(ff, ud) == 0);
+}
+#endif /* FICL_PLATFORM_HAS_FTRUNCATE */
+#endif /* FICL_WANT_FILE */
+
+void
+ficlSystemCompileFile(ficlSystem *system)
+{
+#if !FICL_WANT_FILE
+	FICL_IGNORE(system);
+#else
+	ficlDictionary *dictionary = ficlSystemGetDictionary(system);
+	ficlDictionary *environment = ficlSystemGetEnvironment(system);
+
+	FICL_SYSTEM_ASSERT(system, dictionary);
+	FICL_SYSTEM_ASSERT(system, environment);
+
+	ficlDictionarySetPrimitive(dictionary, "create-file",
+	    ficlPrimitiveCreateFile,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "open-file",
+	    ficlPrimitiveOpenFile,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "close-file",
+	    ficlPrimitiveCloseFile,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "include-file",
+	    ficlPrimitiveIncludeFile,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "read-file",
+	    ficlPrimitiveReadFile,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "read-line",
+	    ficlPrimitiveReadLine,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "write-file",
+	    ficlPrimitiveWriteFile,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "write-line",
+	    ficlPrimitiveWriteLine,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "file-position",
+	    ficlPrimitiveFilePosition,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "file-size",
+	    ficlPrimitiveFileSize,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "reposition-file",
+	    ficlPrimitiveRepositionFile,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "file-status",
+	    ficlPrimitiveFileStatus,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "flush-file",
+	    ficlPrimitiveFlushFile,  FICL_WORD_DEFAULT);
+
+	ficlDictionarySetPrimitive(dictionary, "delete-file",
+	    ficlPrimitiveDeleteFile,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "rename-file",
+	    ficlPrimitiveRenameFile,  FICL_WORD_DEFAULT);
+
+#if FICL_PLATFORM_HAS_FTRUNCATE
+	ficlDictionarySetPrimitive(dictionary, "resize-file",
+	    ficlPrimitiveResizeFile,  FICL_WORD_DEFAULT);
+
+	ficlDictionarySetConstant(environment, "file", FICL_TRUE);
+	ficlDictionarySetConstant(environment, "file-ext", FICL_TRUE);
+#else /*  FICL_PLATFORM_HAS_FTRUNCATE */
+	ficlDictionarySetConstant(environment, "file", FICL_FALSE);
+	ficlDictionarySetConstant(environment, "file-ext", FICL_FALSE);
+#endif /* FICL_PLATFORM_HAS_FTRUNCATE */
+
+#endif /* !FICL_WANT_FILE */
+}
diff --git a/usr/src/common/ficl/float.c b/usr/src/common/ficl/float.c
new file mode 100644
index 0000000000..3442259f59
--- /dev/null
+++ b/usr/src/common/ficl/float.c
@@ -0,0 +1,474 @@
+/*
+ * 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.10 2010/09/13 18:43:04 asau 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.
+ */
+
+#include "ficl.h"
+
+#if FICL_WANT_FLOAT
+#include <math.h>
+#include <values.h>
+
+
+/*
+ * Create a floating point constant.
+ * fconstant ( r -"name"- )
+ */
+static void
+ficlPrimitiveFConstant(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlString name = ficlVmGetWord(vm);
+
+	FICL_STACK_CHECK(vm->floatStack, 1, 0);
+
+	ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)ficlInstructionFConstantParen, FICL_WORD_DEFAULT);
+	ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->floatStack));
+}
+
+
+ficlWord *
+ficlDictionaryAppendFConstant(ficlDictionary *dictionary, char *name,
+    ficlFloat value)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+	return (ficlDictionaryAppendConstantInstruction(dictionary, s,
+	    ficlInstructionFConstantParen, *(ficlInteger *)(&value)));
+}
+
+
+ficlWord *
+ficlDictionarySetFConstant(ficlDictionary *dictionary, char *name,
+    ficlFloat value)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+	return (ficlDictionarySetConstantInstruction(dictionary, s,
+	    ficlInstructionFConstantParen, *(ficlInteger *)(&value)));
+}
+
+
+
+
+static void
+ficlPrimitiveF2Constant(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlString name = ficlVmGetWord(vm);
+
+	FICL_STACK_CHECK(vm->floatStack, 2, 0);
+
+	ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)ficlInstructionF2ConstantParen, FICL_WORD_DEFAULT);
+	ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->floatStack));
+	ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->floatStack));
+}
+
+ficlWord *
+ficlDictionaryAppendF2Constant(ficlDictionary *dictionary, char *name,
+    ficlFloat value)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+	return (ficlDictionaryAppend2ConstantInstruction(dictionary, s,
+	    ficlInstructionF2ConstantParen, *(ficl2Integer *)(&value)));
+}
+
+ficlWord *
+ficlDictionarySetF2Constant(ficlDictionary *dictionary, char *name,
+    ficlFloat value)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+	return (ficlDictionarySet2ConstantInstruction(dictionary, s,
+	    ficlInstructionF2ConstantParen, *(ficl2Integer *)(&value)));
+}
+
+/*
+ * Display a float in decimal format.
+ * f. ( r -- )
+ */
+static void
+ficlPrimitiveFDot(ficlVm *vm)
+{
+	ficlFloat f;
+
+	FICL_STACK_CHECK(vm->floatStack, 1, 0);
+
+	f = ficlStackPopFloat(vm->floatStack);
+	sprintf(vm->pad, "%#f ", f);
+	ficlVmTextOut(vm, vm->pad);
+}
+
+/*
+ * Display a float in engineering format.
+ * fe. ( r -- )
+ */
+static void
+ficlPrimitiveEDot(ficlVm *vm)
+{
+	ficlFloat f;
+
+	FICL_STACK_CHECK(vm->floatStack, 1, 0);
+
+	f = ficlStackPopFloat(vm->floatStack);
+	sprintf(vm->pad, "%#e ", f);
+	ficlVmTextOut(vm, vm->pad);
+}
+
+/*
+ * d i s p l a y FS t a c k
+ * Display the parameter stack (code for "f.s")
+ * f.s ( -- )
+ */
+struct stackContext
+{
+	ficlVm *vm;
+	int count;
+};
+
+static ficlInteger
+ficlFloatStackDisplayCallback(void *c, ficlCell *cell)
+{
+	struct stackContext *context = (struct stackContext *)c;
+	char buffer[80];
+#ifdef	_LP64
+	snprintf(buffer, sizeof (buffer), "[0x%016lx %3d] %20e (0x%016lx)\n",
+	    (unsigned long) cell, context->count++, cell->f, cell->u);
+#else
+	snprintf(buffer, sizeof (buffer), "[0x%08x %3d] %12e (0x%08x)\n",
+	    (unsigned)cell, context->count++, cell->f, cell->u);
+#endif
+	ficlVmTextOut(context->vm, buffer);
+	return (FICL_TRUE);
+}
+
+void
+ficlVmDisplayFloatStack(ficlVm *vm)
+{
+	struct stackContext context;
+	context.vm = vm;
+	context.count = 0;
+	ficlStackDisplay(vm->floatStack, ficlFloatStackDisplayCallback,
+	    &context);
+}
+
+/*
+ * Do float stack depth.
+ * fdepth ( -- n )
+ */
+static void
+ficlPrimitiveFDepth(ficlVm *vm)
+{
+	int i;
+
+	FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+	i = ficlStackDepth(vm->floatStack);
+	ficlStackPushInteger(vm->dataStack, i);
+}
+
+/*
+ * Compile a floating point literal.
+ */
+static void
+ficlPrimitiveFLiteralImmediate(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlCell cell;
+
+	FICL_STACK_CHECK(vm->floatStack, 1, 0);
+
+	cell = ficlStackPop(vm->floatStack);
+	if (cell.f == 1.0f) {
+		ficlDictionaryAppendUnsigned(dictionary, ficlInstructionF1);
+	} else if (cell.f == 0.0f) {
+		ficlDictionaryAppendUnsigned(dictionary, ficlInstructionF0);
+	} else if (cell.f == -1.0f) {
+		ficlDictionaryAppendUnsigned(dictionary, ficlInstructionFNeg1);
+	} else {
+		ficlDictionaryAppendUnsigned(dictionary,
+		    ficlInstructionFLiteralParen);
+		ficlDictionaryAppendCell(dictionary, cell);
+	}
+}
+
+/*
+ * 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
+ * vm -- Virtual Machine pointer.
+ * s -- String to parse.
+ * Returns 1 if successful, 0 if not.
+ */
+int
+ficlVmParseFloatNumber(ficlVm *vm, ficlString s)
+{
+	unsigned char c;
+	unsigned char digit;
+	char *trace;
+	ficlUnsigned length;
+	ficlFloat power;
+	ficlFloat accum = 0.0f;
+	ficlFloat mant = 0.1f;
+	ficlInteger exponent = 0;
+	char flag = 0;
+	FloatParseState estate = FPS_START;
+
+	FICL_STACK_CHECK(vm->floatStack, 0, 1);
+
+	/*
+	 * floating point numbers only allowed in base 10
+	 */
+	if (vm->base != 10)
+		return (0);
+
+	trace = FICL_STRING_GET_POINTER(s);
+	length = FICL_STRING_GET_LENGTH(s);
+
+	/* Loop through the string's characters. */
+	while ((length--) && ((c = *trace++) != 0)) {
+		switch (estate) {
+			/* At start of the number so look for a sign. */
+		case FPS_START:
+			estate = FPS_ININT;
+			if (c == '-') {
+				flag |= NUMISNEG;
+				break;
+			}
+			if (c == '+') {
+				break;
+			}
+		/* Note!  Drop through to FPS_ININT */
+		/*
+		 * Converting integer part of number.
+		 * Only allow digits, decimal and 'E'.
+		 */
+		case FPS_ININT:
+			if (c == '.') {
+				estate = FPS_INMANT;
+			} else if ((c == 'e') || (c == 'E')) {
+				estate = FPS_STARTEXP;
+			} else {
+				digit = (unsigned char)(c - '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 ((c == 'e') || (c == 'E')) {
+				estate = FPS_STARTEXP;
+			} else {
+				digit = (unsigned char)(c - '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 (c == '-') {
+				flag |= EXPISNEG;
+				break;
+			} else if (c == '+') {
+				break;
+			}
+		/* Note!  Drop through to FPS_INEXP */
+		/*
+		 * Processing the exponent part of number.
+		 * Only allow digits.
+		 */
+		case FPS_INEXP:
+			digit = (unsigned char)(c - '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 */
+#if defined(_LP64)
+		power = (ficlFloat)pow(10.0, exponent);
+#else
+		power = (ficlFloat)powf(10.0, exponent);
+#endif
+		accum *= power;
+	}
+
+	ficlStackPushFloat(vm->floatStack, accum);
+	if (vm->state == FICL_VM_STATE_COMPILE)
+		ficlPrimitiveFLiteralImmediate(vm);
+
+	return (1);
+}
+#endif  /* FICL_WANT_FLOAT */
+
+#if FICL_WANT_LOCALS
+static void
+ficlPrimitiveFLocalParen(ficlVm *vm)
+{
+	ficlLocalParen(vm, 0, 1);
+}
+
+static void
+ficlPrimitiveF2LocalParen(ficlVm *vm)
+{
+	ficlLocalParen(vm, 1, 1);
+}
+#endif /* FICL_WANT_LOCALS */
+
+/*
+ * Add float words to a system's dictionary.
+ * system -- Pointer to the Ficl sytem to add float words to.
+ */
+void
+ficlSystemCompileFloat(ficlSystem *system)
+{
+	ficlDictionary *dictionary = ficlSystemGetDictionary(system);
+	ficlDictionary *environment = ficlSystemGetEnvironment(system);
+#if FICL_WANT_FLOAT
+	ficlCell data;
+#endif
+
+	FICL_SYSTEM_ASSERT(system, dictionary);
+	FICL_SYSTEM_ASSERT(system, environment);
+
+#if FICL_WANT_LOCALS
+	ficlDictionarySetPrimitive(dictionary, "(flocal)",
+	    ficlPrimitiveFLocalParen, FICL_WORD_COMPILE_ONLY);
+	ficlDictionarySetPrimitive(dictionary, "(f2local)",
+	    ficlPrimitiveF2LocalParen, FICL_WORD_COMPILE_ONLY);
+#endif /* FICL_WANT_LOCALS */
+
+#if FICL_WANT_FLOAT
+	ficlDictionarySetPrimitive(dictionary, "fconstant",
+	    ficlPrimitiveFConstant, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "fvalue",
+	    ficlPrimitiveFConstant, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "f2constant",
+	    ficlPrimitiveF2Constant, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "f2value",
+	    ficlPrimitiveF2Constant, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "fdepth", ficlPrimitiveFDepth,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "fliteral",
+	    ficlPrimitiveFLiteralImmediate, FICL_WORD_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "f.", ficlPrimitiveFDot,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "f.s", ficlVmDisplayFloatStack,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "fe.", ficlPrimitiveEDot,
+	    FICL_WORD_DEFAULT);
+
+	/*
+	 * Missing words:
+	 *
+	 * d>f
+	 * f>d
+	 * falign
+	 * faligned
+	 * float+
+	 * floats
+	 * floor
+	 * fmax
+	 * fmin
+	 */
+
+#if defined(_LP64)
+	data.f = MAXDOUBLE;
+#else
+	data.f = MAXFLOAT;
+#endif
+	ficlDictionarySetConstant(environment, "max-float",	data.i);
+	/* not all required words are present */
+	ficlDictionarySetConstant(environment, "floating", FICL_FALSE);
+	ficlDictionarySetConstant(environment, "floating-ext", FICL_FALSE);
+	ficlDictionarySetConstant(environment, "floating-stack",
+	    system->stackSize);
+#else
+	ficlDictionarySetConstant(environment, "floating", FICL_FALSE);
+#endif
+}
diff --git a/usr/src/common/ficl/hash.c b/usr/src/common/ficl/hash.c
new file mode 100644
index 0000000000..3994dfe819
--- /dev/null
+++ b/usr/src/common/ficl/hash.c
@@ -0,0 +1,142 @@
+#include "ficl.h"
+
+#define	FICL_ASSERT_PHASH(hash, expression)	FICL_ASSERT(NULL, expression)
+
+/*
+ * h a s h F o r g e t
+ * Unlink all words in the hash that have addresses greater than or
+ * equal to the address supplied. Implementation factor for FORGET
+ * and MARKER.
+ */
+void
+ficlHashForget(ficlHash *hash, void *where)
+{
+	ficlWord *pWord;
+	unsigned i;
+
+	FICL_ASSERT_PHASH(hash, hash);
+	FICL_ASSERT_PHASH(hash, where);
+
+	for (i = 0; i < hash->size; i++) {
+		pWord = hash->table[i];
+
+		while ((void *)pWord >= where) {
+			pWord = pWord->link;
+		}
+
+		hash->table[i] = pWord;
+	}
+}
+
+/*
+ * h a s h H a s h C o d e
+ *
+ * Generate a 16 bit hashcode from a character string using a rolling
+ * shift and add stolen from PJ Weinberger of Bell Labs fame. Case folds
+ * the name before hashing it...
+ * N O T E : If string has zero length, returns zero.
+ */
+ficlUnsigned16
+ficlHashCode(ficlString s)
+{
+	/* hashPJW */
+	ficlUnsigned8 *trace;
+	ficlUnsigned16 code = (ficlUnsigned16)s.length;
+	ficlUnsigned16 shift = 0;
+
+	if (s.length == 0)
+		return (0);
+
+	/* changed to run without errors under Purify -- lch */
+	for (trace = (ficlUnsigned8 *)s.text;
+	    s.length && *trace; trace++, s.length--) {
+		code = (ficlUnsigned16)((code << 4) + tolower(*trace));
+		shift = (ficlUnsigned16)(code & 0xf000);
+		if (shift) {
+			code ^= (ficlUnsigned16)(shift >> 8);
+			code ^= (ficlUnsigned16)shift;
+		}
+	}
+
+	return ((ficlUnsigned16)code);
+}
+
+/*
+ * h a s h I n s e r t W o r d
+ * Put a word into the hash table using the word's hashcode as
+ * an index (modulo the table size).
+ */
+void
+ficlHashInsertWord(ficlHash *hash, ficlWord *word)
+{
+	ficlWord **pList;
+
+	FICL_ASSERT_PHASH(hash, hash);
+	FICL_ASSERT_PHASH(hash, word);
+
+	if (hash->size == 1) {
+		pList = hash->table;
+	} else {
+		pList = hash->table + (word->hash % hash->size);
+	}
+
+	word->link = *pList;
+	*pList = word;
+}
+
+/*
+ * h a s h L o o k u p
+ * Find a name in the hash table given the hashcode and text of the name.
+ * Returns the address of the corresponding ficlWord if found,
+ * otherwise NULL.
+ * Note: outer loop on link field supports inheritance in wordlists.
+ * It's not part of ANS Forth - Ficl only. hashReset creates wordlists
+ * with NULL link fields.
+ */
+ficlWord *
+ficlHashLookup(ficlHash *hash, ficlString name, ficlUnsigned16 hashCode)
+{
+	ficlUnsigned nCmp = name.length;
+	ficlWord *word;
+	ficlUnsigned16 hashIdx;
+
+	if (nCmp > FICL_NAME_LENGTH)
+		nCmp = FICL_NAME_LENGTH;
+
+	for (; hash != NULL; hash = hash->link) {
+		if (hash->size > 1)
+			hashIdx = (ficlUnsigned16)(hashCode % hash->size);
+		else /* avoid the modulo op for single threaded lists */
+			hashIdx = 0;
+
+		for (word = hash->table[hashIdx]; word; word = word->link) {
+			if ((word->length == name.length) &&
+			    (!ficlStrincmp(name.text, word->name, nCmp)))
+				return (word);
+#if FICL_ROBUST
+			FICL_ASSERT_PHASH(hash, word != word->link);
+#endif
+		}
+	}
+
+	return (NULL);
+}
+
+/*
+ * h a s h R e s e t
+ * Initialize a ficlHash to empty state.
+ */
+void
+ficlHashReset(ficlHash *hash)
+{
+	unsigned i;
+
+	FICL_ASSERT_PHASH(hash, hash);
+
+	for (i = 0; i < hash->size; i++) {
+		hash->table[i] = NULL;
+	}
+
+	hash->link = NULL;
+	hash->name = NULL;
+}
diff --git a/usr/src/common/ficl/loader.c b/usr/src/common/ficl/loader.c
new file mode 100644
index 0000000000..4000e5aabc
--- /dev/null
+++ b/usr/src/common/ficl/loader.c
@@ -0,0 +1,1076 @@
+/*
+ * Copyright (c) 2000 Daniel Capo Sobral
+ * All rights reserved.
+ *
+ * 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$
+ */
+
+/*
+ * l o a d e r . c
+ * Additional FICL words designed for FreeBSD's loader
+ */
+
+#ifndef STAND
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <dirent.h>
+#include <fcntl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <strings.h>
+#include <termios.h>
+#else
+#include <stand.h>
+#ifdef __i386__
+#include <machine/cpufunc.h>
+#endif
+#include "bootstrap.h"
+#endif
+#include <string.h>
+#include "ficl.h"
+
+extern int biospci_count_device_type(uint32_t);
+extern int biospci_write_config(uint32_t, int, int, uint32_t);
+extern int biospci_read_config(uint32_t, int, int, uint32_t *);
+extern int biospci_find_devclass(uint32_t, int, uint32_t *);
+extern int biospci_find_device(uint32_t, int, uint32_t *);
+extern uint32_t biospci_locator(uint8_t, uint8_t, uint8_t);
+
+/*
+ *		FreeBSD's loader interaction words and extras
+ *
+ *		setenv      ( value n name n' -- )
+ *		setenv?     ( value n name n' flag -- )
+ *		getenv      ( addr n -- addr' n' | -1 )
+ *		unsetenv    ( addr n -- )
+ *		copyin      ( addr addr' len -- )
+ *		copyout     ( addr addr' len -- )
+ *		findfile    ( name len type len' -- addr )
+ *		pnpdevices  ( -- addr )
+ *		pnphandlers ( -- addr )
+ *		ccall       ( [[...[p10] p9] ... p1] n addr -- result )
+ *		.#	    ( value -- )
+ */
+
+void
+ficlSetenv(ficlVm *pVM)
+{
+	char *name, *value;
+	char *namep, *valuep;
+	int names, values;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 4, 0);
+
+	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
+	values = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	valuep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
+
+	name = (char *)ficlMalloc(names+1);
+	if (!name)
+		ficlVmThrowError(pVM, "Error: out of memory");
+	strncpy(name, namep, names);
+	name[names] = '\0';
+	value = (char *)ficlMalloc(values+1);
+	if (!value)
+		ficlVmThrowError(pVM, "Error: out of memory");
+	strncpy(value, valuep, values);
+	value[values] = '\0';
+
+	setenv(name, value, 1);
+	ficlFree(name);
+	ficlFree(value);
+}
+
+void
+ficlSetenvq(ficlVm *pVM)
+{
+	char *name, *value;
+	char *namep, *valuep;
+	int names, values, overwrite;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 5, 0);
+
+	overwrite = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
+	values = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	valuep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
+
+	name = (char *)ficlMalloc(names+1);
+	if (!name)
+		ficlVmThrowError(pVM, "Error: out of memory");
+	strncpy(name, namep, names);
+	name[names] = '\0';
+	value = (char *)ficlMalloc(values+1);
+	if (!value)
+		ficlVmThrowError(pVM, "Error: out of memory");
+	strncpy(value, valuep, values);
+	value[values] = '\0';
+
+	setenv(name, value, overwrite);
+	ficlFree(name);
+	ficlFree(value);
+}
+
+void
+ficlGetenv(ficlVm *pVM)
+{
+	char *name, *value;
+	char *namep;
+	int names;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 2);
+
+	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
+
+	name = (char *)ficlMalloc(names+1);
+	if (!name)
+		ficlVmThrowError(pVM, "Error: out of memory");
+	strncpy(name, namep, names);
+	name[names] = '\0';
+
+	value = getenv(name);
+	ficlFree(name);
+
+	if (value != NULL) {
+		ficlStackPushPointer(ficlVmGetDataStack(pVM), value);
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(value));
+	} else
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
+}
+
+void
+ficlUnsetenv(ficlVm *pVM)
+{
+	char *name;
+	char *namep;
+	int names;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0);
+
+	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
+
+	name = (char *)ficlMalloc(names+1);
+	if (!name)
+		ficlVmThrowError(pVM, "Error: out of memory");
+	strncpy(name, namep, names);
+	name[names] = '\0';
+
+	unsetenv(name);
+	ficlFree(name);
+}
+
+void
+ficlCopyin(ficlVm *pVM)
+{
+#ifdef STAND
+	void*		src;
+	vm_offset_t	dest;
+	size_t		len;
+#endif
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 0);
+
+#ifdef STAND
+	len = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	dest = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	src = ficlStackPopPointer(ficlVmGetDataStack(pVM));
+	archsw.arch_copyin(src, dest, len);
+#else
+	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	(void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
+#endif
+}
+
+void
+ficlCopyout(ficlVm *pVM)
+{
+#ifdef STAND
+	void*		dest;
+	vm_offset_t	src;
+	size_t		len;
+#endif
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 0);
+
+#ifdef STAND
+	len = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	dest = ficlStackPopPointer(ficlVmGetDataStack(pVM));
+	src = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	archsw.arch_copyout(src, dest, len);
+#else
+	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	(void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
+	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
+#endif
+}
+
+void
+ficlFindfile(ficlVm *pVM)
+{
+#ifdef STAND
+	char	*name, *type;
+	char	*namep, *typep;
+	int	names, types;
+#endif
+	struct	preloaded_file *fp;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 4, 1);
+
+#ifdef STAND
+	types = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	typep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
+	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
+
+	name = (char *)ficlMalloc(names+1);
+	if (!name)
+		ficlVmThrowError(pVM, "Error: out of memory");
+	strncpy(name, namep, names);
+	name[names] = '\0';
+	type = (char *)ficlMalloc(types+1);
+	if (!type)
+		ficlVmThrowError(pVM, "Error: out of memory");
+	strncpy(type, typep, types);
+	type[types] = '\0';
+
+	fp = file_findfile(name, type);
+#else
+	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	(void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
+	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	(void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
+
+	fp = NULL;
+#endif
+	ficlStackPushPointer(ficlVmGetDataStack(pVM), fp);
+}
+
+#ifdef STAND
+#ifdef HAVE_PNP
+
+void
+ficlPnpdevices(ficlVm *pVM)
+{
+	static int pnp_devices_initted = 0;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
+
+	if (!pnp_devices_initted) {
+		STAILQ_INIT(&pnp_devices);
+		pnp_devices_initted = 1;
+	}
+
+	ficlStackPushPointer(ficlVmGetDataStack(pVM), &pnp_devices);
+}
+
+void
+ficlPnphandlers(ficlVm *pVM)
+{
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
+
+	ficlStackPushPointer(ficlVmGetDataStack(pVM), pnphandlers);
+}
+
+#endif
+#endif /* ifdef STAND */
+
+void
+ficlCcall(ficlVm *pVM)
+{
+	int (*func)(int, ...);
+	int result, p[10];
+	int nparam, i;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0);
+
+	func = (int (*)(int, ...))ficlStackPopPointer(ficlVmGetDataStack(pVM));
+	nparam = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), nparam, 1);
+
+	for (i = 0; i < nparam; i++)
+		p[i] = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+
+	result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8],
+	    p[9]);
+
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), result);
+}
+
+/*
+ * f i c l E x e c F D
+ * reads in text from file fd and passes it to ficlExec()
+ * returns FICL_VM_STATUS_OUT_OF_TEXT on success or the ficlExec() error
+ * code on failure.
+ */
+#define	nLINEBUF	256
+int
+ficlExecFD(ficlVm *pVM, int fd)
+{
+	char cp[nLINEBUF];
+	int nLine = 0, rval = FICL_VM_STATUS_OUT_OF_TEXT;
+	char ch;
+	ficlCell id;
+	ficlString s;
+
+	id = pVM->sourceId;
+	pVM->sourceId.i = fd+1; /* in loader we can get 0, there is no stdin */
+
+	/* feed each line to ficlExec */
+	while (1) {
+		int status, i;
+
+		i = 0;
+		while ((status = read(fd, &ch, 1)) > 0 && ch != '\n')
+			cp[i++] = ch;
+		nLine++;
+		if (!i) {
+			if (status < 1)
+				break;
+			continue;
+		}
+		if (cp[i] == '\n')
+			cp[i] = '\0';
+
+		FICL_STRING_SET_POINTER(s, cp);
+		FICL_STRING_SET_LENGTH(s, i);
+
+		rval = ficlVmExecuteString(pVM, s);
+		if (rval != FICL_VM_STATUS_QUIT &&
+		    rval != FICL_VM_STATUS_USER_EXIT &&
+		    rval != FICL_VM_STATUS_OUT_OF_TEXT) {
+			pVM->sourceId = id;
+			(void) ficlVmEvaluate(pVM, "");
+			return (rval);
+		}
+	}
+	pVM->sourceId = id;
+
+	/*
+	 * Pass an empty line with SOURCE-ID == -1 to flush
+	 * any pending REFILLs (as required by FILE wordset)
+	 */
+	(void) ficlVmEvaluate(pVM, "");
+
+	if (rval == FICL_VM_STATUS_USER_EXIT)
+		ficlVmThrow(pVM, FICL_VM_STATUS_USER_EXIT);
+
+	return (rval);
+}
+
+static void displayCellNoPad(ficlVm *pVM)
+{
+	ficlCell c;
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
+
+	c = ficlStackPop(ficlVmGetDataStack(pVM));
+	ficlLtoa((c).i, pVM->pad, pVM->base);
+	ficlVmTextOut(pVM, pVM->pad);
+}
+
+/*
+ * isdir? - Return whether an fd corresponds to a directory.
+ *
+ * isdir? ( fd -- bool )
+ */
+static void
+isdirQuestion(ficlVm *pVM)
+{
+	struct stat sb;
+	ficlInteger flag;
+	int fd;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 1);
+
+	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	flag = FICL_FALSE;
+	do {
+		if (fd < 0)
+			break;
+		if (fstat(fd, &sb) < 0)
+			break;
+		if (!S_ISDIR(sb.st_mode))
+			break;
+		flag = FICL_TRUE;
+	} while (0);
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
+}
+
+/*
+ * fopen - open a file and return new fd on stack.
+ *
+ * fopen ( ptr count mode -- fd )
+ */
+extern char *get_dev(const char *);
+
+static void
+pfopen(ficlVm *pVM)
+{
+	int mode, fd, count;
+	char *ptr, *name;
+#ifndef STAND
+	char *tmp;
+#endif
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
+
+	mode = ficlStackPopInteger(ficlVmGetDataStack(pVM));	/* get mode */
+	count = ficlStackPopInteger(ficlVmGetDataStack(pVM));	/* get count */
+	ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM));	/* get ptr */
+
+	if ((count < 0) || (ptr == NULL)) {
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
+		return;
+	}
+
+	/* ensure that the string is null terminated */
+	name = (char *)malloc(count+1);
+	bcopy(ptr, name, count);
+	name[count] = 0;
+#ifndef STAND
+	tmp = get_dev(name);
+	free(name);
+	name = tmp;
+#endif
+
+	/* open the file */
+	fd = open(name, mode);
+	free(name);
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), fd);
+}
+
+/*
+ * fclose - close a file who's fd is on stack.
+ * fclose ( fd -- )
+ */
+static void
+pfclose(ficlVm *pVM)
+{
+	int fd;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
+
+	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
+	if (fd != -1)
+		close(fd);
+}
+
+/*
+ * fread - read file contents
+ * fread  ( fd buf nbytes  -- nread )
+ */
+static void
+pfread(ficlVm *pVM)
+{
+	int fd, len;
+	char *buf;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
+
+	len = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	buf = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get buffer */
+	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
+	if (len > 0 && buf && fd != -1)
+		ficlStackPushInteger(ficlVmGetDataStack(pVM),
+		    read(fd, buf, len));
+	else
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
+}
+
+/*
+ * fopendir - open directory
+ *
+ * fopendir ( addr len -- ptr TRUE | FALSE )
+ */
+static void pfopendir(ficlVm *pVM)
+{
+#ifndef STAND
+	DIR *dir;
+	char *tmp;
+#else
+	struct stat sb;
+	int fd;
+#endif
+	int count;
+	char *ptr, *name;
+	ficlInteger flag = FICL_FALSE;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 1);
+
+	count = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM));	/* get ptr */
+
+	if ((count < 0) || (ptr == NULL)) {
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
+		return;
+	}
+	/* ensure that the string is null terminated */
+	name = (char *)malloc(count+1);
+	bcopy(ptr, name, count);
+	name[count] = 0;
+#ifndef STAND
+	tmp = get_dev(name);
+	free(name);
+	name = tmp;
+#else
+	fd = open(name, O_RDONLY);
+	free(name);
+	do {
+		if (fd < 0)
+			break;
+		if (fstat(fd, &sb) < 0)
+			break;
+		if (!S_ISDIR(sb.st_mode))
+			break;
+		flag = FICL_TRUE;
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), fd);
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
+		return;
+	} while (0);
+
+	if (fd >= 0)
+		close(fd);
+
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
+		return;
+#endif
+#ifndef STAND
+	dir = opendir(name);
+	if (dir == NULL) {
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
+		return;
+	} else
+		flag = FICL_TRUE;
+
+	ficlStackPushPointer(ficlVmGetDataStack(pVM), dir);
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
+#endif
+}
+
+/*
+ * freaddir - read directory contents
+ * freaddir ( fd -- ptr len TRUE | FALSE )
+ */
+static void
+pfreaddir(ficlVm *pVM)
+{
+#ifndef STAND
+	static DIR *dir = NULL;
+#else
+	int fd;
+#endif
+	struct dirent *d = NULL;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 3);
+	/*
+	 * libstand readdir does not always return . nor .. so filter
+	 * them out to have consistent behaviour.
+	 */
+#ifndef STAND
+	dir = ficlStackPopPointer(ficlVmGetDataStack(pVM));
+	if (dir != NULL)
+		do {
+			d = readdir(dir);
+			if (d != NULL && strcmp(d->d_name, ".") == 0)
+				continue;
+			if (d != NULL && strcmp(d->d_name, "..") == 0)
+				continue;
+			break;
+		} while (d != NULL);
+#else
+	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	if (fd != -1)
+		do {
+			d = readdirfd(fd);
+			if (d != NULL && strcmp(d->d_name, ".") == 0)
+				continue;
+			if (d != NULL && strcmp(d->d_name, "..") == 0)
+				continue;
+			break;
+		} while (d != NULL);
+#endif
+	if (d != NULL) {
+		ficlStackPushPointer(ficlVmGetDataStack(pVM), d->d_name);
+		ficlStackPushInteger(ficlVmGetDataStack(pVM),
+		    strlen(d->d_name));
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), FICL_TRUE);
+	} else {
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), FICL_FALSE);
+	}
+}
+
+/*
+ * fclosedir - close a dir on stack.
+ *
+ * fclosedir ( fd -- )
+ */
+static void
+pfclosedir(ficlVm *pVM)
+{
+#ifndef STAND
+	DIR *dir;
+#else
+	int fd;
+#endif
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
+
+#ifndef STAND
+	dir = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get dir */
+	if (dir != NULL)
+		closedir(dir);
+#else
+	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
+	if (fd != -1)
+		close(fd);
+#endif
+}
+
+/*
+ * fload - interpret file contents
+ *
+ * fload  ( fd -- )
+ */
+static void pfload(ficlVm *pVM)
+{
+	int fd;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
+
+	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
+	if (fd != -1)
+		ficlExecFD(pVM, fd);
+}
+
+/*
+ * fwrite - write file contents
+ *
+ * fwrite  ( fd buf nbytes  -- nwritten )
+ */
+static void
+pfwrite(ficlVm *pVM)
+{
+	int fd, len;
+	char *buf;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
+
+	len = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* bytes to read */
+	buf = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get buffer */
+	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
+	if (len > 0 && buf && fd != -1)
+		ficlStackPushInteger(ficlVmGetDataStack(pVM),
+		    write(fd, buf, len));
+	else
+		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
+}
+
+/*
+ * fseek - seek to a new position in a file
+ *
+ * fseek  ( fd ofs whence  -- pos )
+ */
+static void
+pfseek(ficlVm *pVM)
+{
+	int fd, pos, whence;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
+
+	whence = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	pos = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), lseek(fd, pos, whence));
+}
+
+/*
+ * key - get a character from stdin
+ *
+ * key ( -- char )
+ */
+static void
+key(ficlVm *pVM)
+{
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
+
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), getchar());
+}
+
+/*
+ * key? - check for a character from stdin (FACILITY)
+ * key? ( -- flag )
+ */
+static void
+keyQuestion(ficlVm *pVM)
+{
+#ifndef STAND
+	char ch = -1;
+	struct termios oldt;
+	struct termios newt;
+#endif
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
+
+#ifndef STAND
+	tcgetattr(STDIN_FILENO, &oldt);
+	newt = oldt;
+	newt.c_lflag &= ~(ICANON | ECHO);
+	newt.c_cc[VMIN] = 0;
+	newt.c_cc[VTIME] = 0;
+	tcsetattr(STDIN_FILENO, TCSANOW, &newt);
+	ch = getchar();
+	tcsetattr(STDIN_FILENO, TCSANOW, &oldt);
+
+	if (ch != -1)
+		(void) ungetc(ch, stdin);
+
+	ficlStackPushInteger(ficlVmGetDataStack(pVM),
+	    ch != -1? FICL_TRUE : FICL_FALSE);
+#else
+	ficlStackPushInteger(ficlVmGetDataStack(pVM),
+	    ischar()? FICL_TRUE : FICL_FALSE);
+#endif
+}
+
+/*
+ * seconds - gives number of seconds since beginning of time
+ *
+ * beginning of time is defined as:
+ *
+ *	BTX	- number of seconds since midnight
+ *	FreeBSD	- number of seconds since Jan 1 1970
+ *
+ * seconds ( -- u )
+ */
+static void
+pseconds(ficlVm *pVM)
+{
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
+
+	ficlStackPushUnsigned(ficlVmGetDataStack(pVM),
+	    (ficlUnsigned) time(NULL));
+}
+
+/*
+ * ms - wait at least that many milliseconds (FACILITY)
+ * ms ( u -- )
+ */
+static void
+ms(ficlVm *pVM)
+{
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
+
+#ifndef STAND
+	usleep(ficlStackPopUnsigned(ficlVmGetDataStack(pVM)) * 1000);
+#else
+	delay(ficlStackPopUnsigned(ficlVmGetDataStack(pVM)) * 1000);
+#endif
+}
+
+/*
+ * fkey - get a character from a file
+ * fkey ( file -- char )
+ */
+static void
+fkey(ficlVm *pVM)
+{
+	int i, fd;
+	char ch;
+
+	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 1);
+
+	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	i = read(fd, &ch, 1);
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), i > 0 ? ch : -1);
+}
+
+
+#ifdef STAND
+#ifdef __i386__
+
+/*
+ * outb ( port# c -- )
+ * Store a byte to I/O port number port#
+ */
+void
+ficlOutb(ficlVm *pVM)
+{
+	uint8_t c;
+	uint32_t port;
+
+	port = ficlStackPopUnsigned(ficlVmGetDataStack(pVM));
+	c = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	outb(port, c);
+}
+
+/*
+ * inb ( port# -- c )
+ * Fetch a byte from I/O port number port#
+ */
+void
+ficlInb(ficlVm *pVM)
+{
+	uint8_t c;
+	uint32_t port;
+
+	port = ficlStackPopUnsigned(ficlVmGetDataStack(pVM));
+	c = inb(port);
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), c);
+}
+
+/*
+ * pcibios-device-count (devid -- count)
+ *
+ * Returns the PCI BIOS' count of how many devices matching devid are
+ * in the system. devid is the 32-bit vendor + device.
+ */
+static void
+ficlPciBiosCountDevices(ficlVm *pVM)
+{
+	uint32_t devid;
+	int i;
+
+	devid = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+
+	i = biospci_count_device_type(devid);
+
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), i);
+}
+
+/*
+ * pcibios-write-config (locator offset width value -- )
+ *
+ * Writes the specified config register.
+ * Locator is bus << 8 | device << 3 | fuction
+ * offset is the pci config register
+ * width is 0 for byte, 1 for word, 2 for dword
+ * value is the value to write
+ */
+static void
+ficlPciBiosWriteConfig(ficlVm *pVM)
+{
+	uint32_t value, width, offset, locator;
+
+	value = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	width = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	offset = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	locator = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+
+	biospci_write_config(locator, offset, width, value);
+}
+
+/*
+ * pcibios-read-config (locator offset width -- value)
+ *
+ * Reads the specified config register.
+ * Locator is bus << 8 | device << 3 | fuction
+ * offset is the pci config register
+ * width is 0 for byte, 1 for word, 2 for dword
+ * value is the value to read from the register
+ */
+static void
+ficlPciBiosReadConfig(ficlVm *pVM)
+{
+	uint32_t value, width, offset, locator;
+
+	width = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	offset = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	locator = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+
+	biospci_read_config(locator, offset, width, &value);
+
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), value);
+}
+
+/*
+ * pcibios-find-devclass (class index -- locator)
+ *
+ * Finds the index'th instance of class in the pci tree.
+ * must be an exact match.
+ * class is the class to search for.
+ * index 0..N (set to 0, increment until error)
+ *
+ * Locator is bus << 8 | device << 3 | fuction (or -1 on error)
+ */
+static void
+ficlPciBiosFindDevclass(ficlVm *pVM)
+{
+	uint32_t index, class, locator;
+
+	index = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	class = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+
+	if (biospci_find_devclass(class, index, &locator))
+		locator = 0xffffffff;
+
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), locator);
+}
+
+/*
+ * pcibios-find-device(devid index -- locator)
+ *
+ * Finds the index'th instance of devid in the pci tree.
+ * must be an exact match.
+ * class is the class to search for.
+ * index 0..N (set to 0, increment until error)
+ *
+ * Locator is bus << 8 | device << 3 | fuction (or -1 on error)
+ */
+static void
+ficlPciBiosFindDevice(ficlVm *pVM)
+{
+	uint32_t index, devid, locator;
+
+	index = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	devid = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+
+	if (biospci_find_device(devid, index, &locator))
+		locator = 0xffffffff;
+
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), locator);
+}
+
+/*
+ * pcibios-find-device(bus device function -- locator)
+ *
+ * converts bus, device, function to locator.
+ *
+ * Locator is bus << 8 | device << 3 | fuction
+ */
+static void
+ficlPciBiosLocator(ficlVm *pVM)
+{
+	uint32_t bus, device, function, locator;
+
+	function = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	device = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+	bus = ficlStackPopInteger(ficlVmGetDataStack(pVM));
+
+	locator = biospci_locator(bus, device, function);
+
+	ficlStackPushInteger(ficlVmGetDataStack(pVM), locator);
+}
+#endif
+#endif
+
+/*
+ * Retrieves free space remaining on the dictionary
+ */
+static void
+freeHeap(ficlVm *pVM)
+{
+	ficlStackPushInteger(ficlVmGetDataStack(pVM),
+	    ficlDictionaryCellsAvailable(ficlVmGetDictionary(pVM)));
+}
+
+/*
+ * f i c l C o m p i l e P l a t f o r m
+ * Build FreeBSD platform extensions into the system dictionary
+ */
+void
+ficlSystemCompilePlatform(ficlSystem *pSys)
+{
+	ficlDictionary *dp = ficlSystemGetDictionary(pSys);
+	ficlDictionary *env = ficlSystemGetEnvironment(pSys);
+
+	FICL_SYSTEM_ASSERT(pSys, dp);
+	FICL_SYSTEM_ASSERT(pSys, env);
+
+	ficlDictionarySetPrimitive(dp, ".#", displayCellNoPad,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "isdir?", isdirQuestion,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "fopen", pfopen, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "fclose", pfclose, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "fread", pfread, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "fopendir", pfopendir,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "freaddir", pfreaddir,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "fclosedir", pfclosedir,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "fload", pfload, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "fkey", fkey, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "fseek", pfseek, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "fwrite", pfwrite, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "key", key, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "key?", keyQuestion, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "ms", ms, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "seconds", pseconds, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "heap?", freeHeap, FICL_WORD_DEFAULT);
+
+	ficlDictionarySetPrimitive(dp, "setenv", ficlSetenv, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "setenv?", ficlSetenvq,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "getenv", ficlGetenv, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "unsetenv", ficlUnsetenv,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "copyin", ficlCopyin, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "copyout", ficlCopyout,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "findfile", ficlFindfile,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "ccall", ficlCcall, FICL_WORD_DEFAULT);
+#ifdef STAND
+#ifdef __i386__
+	ficlDictionarySetPrimitive(dp, "outb", ficlOutb, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "inb", ficlInb, FICL_WORD_DEFAULT);
+#endif
+#ifdef HAVE_PNP
+	ficlDictionarySetPrimitive(dp, "pnpdevices", ficlPnpdevices,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "pnphandlers", ficlPnphandlers,
+	    FICL_WORD_DEFAULT);
+#endif
+#ifdef __i386__
+	ficlDictionarySetPrimitive(dp, "pcibios-device-count",
+	    ficlPciBiosCountDevices, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "pcibios-read-config",
+	    ficlPciBiosReadConfig, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "pcibios-write-config",
+	    ficlPciBiosWriteConfig, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "pcibios-find-devclass",
+	    ficlPciBiosFindDevclass, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "pcibios-find-device",
+	    ficlPciBiosFindDevice, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dp, "pcibios-locator", ficlPciBiosLocator,
+	    FICL_WORD_DEFAULT);
+#endif
+#endif
+
+#if defined(__i386__) || defined(__amd64__)
+	ficlDictionarySetConstant(env, "arch-i386", FICL_TRUE);
+	ficlDictionarySetConstant(env, "arch-sparc", FICL_FALSE);
+#endif
+#ifdef __sparc
+	ficlDictionarySetConstant(env, "arch-i386", FICL_FALSE);
+	ficlDictionarySetConstant(env, "arch-sparc", FICL_TRUE);
+#endif
+}
diff --git a/usr/src/common/ficl/main.c b/usr/src/common/ficl/main.c
new file mode 100644
index 0000000000..8e8bd0f207
--- /dev/null
+++ b/usr/src/common/ficl/main.c
@@ -0,0 +1,144 @@
+/*
+ * stub main for testing Ficl
+ * $Id: main.c,v 1.2 2010/09/10 09:01:28 asau 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.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <termios.h>
+#include <sys/errno.h>
+
+#include <ficl.h>
+#include <ficlplatform/emu.h>
+#include <libtecla.h>
+
+#define	LINELEN	1024
+#define	HISTORY	2048
+
+static char *
+prompt(void)
+{
+	static char prompt[20]; /* probably too large, but well... */
+	char *pr, *p, *cp, *ev;
+	int n = 0;
+
+	if ((cp = getenv("prompt")) == NULL)
+		cp = ">";
+	pr = p = strdup(cp);
+
+	while (*p != 0) {
+		if ((*p == '$') && (*(p+1) == '{')) {
+			for (cp = p + 2; (*cp != 0) && (*cp != '}'); cp++)
+				;
+			*cp = 0;
+			ev = getenv(p + 2);
+
+			if (ev != NULL)
+				n = sprintf(prompt+n, "%s", ev);
+			p = cp + 1;
+			continue;
+		}
+		prompt[n++] = *p;
+		p++;
+	}
+	if (prompt[n - 1] != ' ')
+		prompt[n++] = ' ';
+	prompt[n] = '\0';
+	free(pr);
+	return (prompt);
+}
+
+int
+main(int argc, char **argv)
+{
+	int returnValue = 0;
+	char *buffer;
+	GetLine *gl;
+	ficlVm *vm;
+	struct winsize ws;
+	int cols = 80, rows = 24;
+
+	if (ioctl(1, TIOCGWINSZ, &ws) != -1) {
+		if (ws.ws_col)
+			cols = ws.ws_col;
+		if (ws.ws_row)
+			rows = ws.ws_row;
+	}
+
+	clearenv();
+	asprintf(&buffer, "%d", cols);
+	setenv("COLUMNS", buffer, 1);
+	free(buffer);
+	asprintf(&buffer, "%d", rows);
+	setenv("LINES", buffer, 1);
+	free(buffer);
+
+	if (getenv("prompt") == NULL)
+		setenv("prompt", "${interpret}", 1);
+	if (getenv("interpret") == NULL)
+		setenv("interpret", "ok", 1);
+
+	if ((vm = bf_init("", NULL)) == NULL)
+		return (ENOMEM);
+	returnValue = ficlVmEvaluate(vm, ".ver .( " __DATE__ " ) cr quit");
+
+	/*
+	 * load files specified on command-line
+	 */
+	if (argc  > 1) {
+		asprintf(&buffer, ".( loading %s ) cr include %s\n cr",
+		    argv[1], argv[1]);
+		returnValue = ficlVmEvaluate(vm, buffer);
+		free(buffer);
+	}
+
+	if ((gl = new_GetLine(LINELEN, HISTORY)) == NULL) {
+		bf_fini();
+		return (ENOMEM);
+	}
+
+	while (returnValue != FICL_VM_STATUS_USER_EXIT) {
+		if ((buffer = gl_get_line(gl, prompt(), NULL, -1)) == NULL)
+			break;
+		returnValue = bf_run(buffer);
+	}
+
+	gl = del_GetLine(gl);
+	bf_fini();
+	return (returnValue);
+}
diff --git a/usr/src/common/ficl/prefix.c b/usr/src/common/ficl/prefix.c
new file mode 100644
index 0000000000..8e396d92cb
--- /dev/null
+++ b/usr/src/common/ficl/prefix.c
@@ -0,0 +1,182 @@
+/*
+ * p r e f i x . c
+ * Forth Inspired Command Language
+ * Parser extensions for Ficl
+ * Authors: Larry Hastings & John Sadler (john_sadler@alum.mit.edu)
+ * Created: April 2001
+ * $Id: prefix.c,v 1.8 2010/09/13 18:43:04 asau 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.
+ */
+
+#include "ficl.h"
+
+/*
+ * (jws) revisions:
+ * A prefix is a word in a dedicated wordlist (name stored in list_name below)
+ * that is searched in a special way by the prefix parse step. When a prefix
+ * matches the beginning of an incoming token, push the non-prefix part of the
+ * token back onto the input stream and execute the prefix code.
+ *
+ * The parse step is called ficlParsePrefix.
+ * Storing prefix entries in the dictionary greatly simplifies
+ * the process of matching and dispatching prefixes, avoids the
+ * need to clean up a dynamically allocated prefix list when the system
+ * goes away, but still allows prefixes to be allocated at runtime.
+ */
+
+static char list_name[] = "<prefixes>";
+
+/*
+ * f i c l P a r s e P r e f i x
+ * This is the parse step for prefixes - it checks an incoming word
+ * to see if it starts with a prefix, and if so runs the corresponding
+ * code against the remainder of the word and returns true.
+ */
+int
+ficlVmParsePrefix(ficlVm *vm, ficlString s)
+{
+	int i;
+	ficlHash *hash;
+	ficlWord *word = ficlSystemLookup(vm->callback.system, 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 (!word)
+		return (0); /* false */
+
+	hash = (ficlHash *)(word->param[0].p);
+	/*
+	 * Walk the list looking for a match with the beginning of the
+	 * incoming token
+	 */
+	for (i = 0; i < (int)hash->size; i++) {
+		word = hash->table[i];
+		while (word != NULL) {
+			int n;
+			n = word->length;
+			/*
+			 * If we find a match, adjust the TIB to give back
+			 * the non-prefix characters and execute the prefix
+			 * word.
+			 */
+			if (!ficlStrincmp(FICL_STRING_GET_POINTER(s),
+			    word->name, (ficlUnsigned)n)) {
+				/*
+				 * (sadler) fixed off-by-one error when the
+				 * token has no trailing space in the TIB
+				 */
+				ficlVmSetTibIndex(vm,
+				    s.text + n - vm->tib.text);
+				ficlVmExecuteWord(vm, word);
+
+				return (1); /* true */
+			}
+			word = word->link;
+		}
+	}
+
+	return (0); /* false */
+}
+
+static void
+ficlPrimitiveTempBase(ficlVm *vm)
+{
+	int oldbase = vm->base;
+	ficlString number = ficlVmGetWord0(vm);
+	int base = ficlStackPopInteger(vm->dataStack);
+
+	vm->base = base;
+	if (!ficlVmParseNumber(vm, number))
+		ficlVmThrowError(vm, "%.*s not recognized",
+		    FICL_STRING_GET_LENGTH(number),
+		    FICL_STRING_GET_POINTER(number));
+
+	vm->base = oldbase;
+}
+
+/*
+ * f i c l C o m p i l e P r e f i x
+ * Build prefix support into the dictionary and the parser
+ * Note: since prefixes always execute, they are effectively IMMEDIATE.
+ * If they need to generate code in compile state you must add
+ * this code explicitly.
+ */
+void
+ficlSystemCompilePrefix(ficlSystem *system)
+{
+	ficlDictionary *dictionary = system->dictionary;
+	ficlHash *hash;
+
+	/*
+	 * Create a named wordlist for prefixes to reside in...
+	 * Since we're doing a special kind of search, make it
+	 * a single bucket hashtable - hashing does not help here.
+	 */
+	hash = ficlDictionaryCreateWordlist(dictionary, 1);
+	hash->name = list_name;
+	ficlDictionaryAppendConstantPointer(dictionary, list_name, hash);
+
+	/*
+	 * Put __tempbase in the forth-wordlist
+	 */
+	ficlDictionarySetPrimitive(dictionary, "__tempbase",
+	    ficlPrimitiveTempBase, FICL_WORD_DEFAULT);
+
+	/*
+	 * If you want to add some prefixes at compilation-time, copy this
+	 * line to the top of this function:
+	 *
+	 * ficlHash *oldCompilationWordlist;
+	 *
+	 * then copy this code to the bottom, just above the return:
+	 *
+	 *
+	 * oldCompilationWordlist = dictionary->compilationWordlist;
+	 * dictionary->compilationWordlist = hash;
+	 * ficlDictionarySetPrimitive(dictionary, YOUR WORD HERE,
+	 * FICL_WORD_DEFAULT);
+	 * dictionary->compilationWordlist = oldCompilationWordlist;
+	 *
+	 * and substitute in your own actual calls to
+	 * ficlDictionarySetPrimitive() as needed.
+	 *
+	 * Or--better yet--do it in your own code, so you don't have
+	 * to re-modify the Ficl source code every time we cut a new release!
+	 */
+}
diff --git a/usr/src/common/ficl/primitives.c b/usr/src/common/ficl/primitives.c
new file mode 100644
index 0000000000..c8b9829705
--- /dev/null
+++ b/usr/src/common/ficl/primitives.c
@@ -0,0 +1,3496 @@
+/*
+ * w o r d s . c
+ * Forth Inspired Command Language
+ * ANS Forth CORE word-set written in C
+ * Author: John Sadler (john_sadler@alum.mit.edu)
+ * Created: 19 July 1997
+ * $Id: primitives.c,v 1.4 2010/09/13 18:43:04 asau 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.
+ */
+
+#include "ficl.h"
+#include <limits.h>
+
+/*
+ * Control structure building words use these
+ * strings' addresses as markers on the stack to
+ * check for structure completion.
+ */
+static char doTag[]    = "do";
+static char colonTag[] = "colon";
+static char leaveTag[] = "leave";
+
+static char destTag[]  = "target";
+static char origTag[]  = "origin";
+
+static char caseTag[]  = "case";
+static char ofTag[]  = "of";
+static char fallthroughTag[]  = "fallthrough";
+
+/*
+ * C O N T R O L   S T R U C T U R E   B U I L D E R S
+ *
+ * Push current dictionary location for later branch resolution.
+ * The location may be either a branch target or a patch address...
+ */
+static void
+markBranch(ficlDictionary *dictionary, ficlVm *vm, char *tag)
+{
+	ficlStackPushPointer(vm->dataStack, dictionary->here);
+	ficlStackPushPointer(vm->dataStack, tag);
+}
+
+static void
+markControlTag(ficlVm *vm, char *tag)
+{
+	ficlStackPushPointer(vm->dataStack, tag);
+}
+
+static void
+matchControlTag(ficlVm *vm, char *wantTag)
+{
+	char *tag;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	tag = (char *)ficlStackPopPointer(vm->dataStack);
+
+	/*
+	 * Changed the code below to compare the pointers first
+	 * (by popular demand)
+	 */
+	if ((tag != wantTag) && strcmp(tag, wantTag)) {
+		ficlVmThrowError(vm,
+		    "Error -- unmatched control structure \"%s\"", wantTag);
+	}
+}
+
+/*
+ * Expect a branch target address on the param stack,
+ * FICL_VM_STATE_COMPILE a literal offset from the current dictionary location
+ * to the target address
+ */
+static void
+resolveBackBranch(ficlDictionary *dictionary, ficlVm *vm, char *tag)
+{
+	ficlCell *patchAddr, c;
+
+	matchControlTag(vm, tag);
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	patchAddr = (ficlCell *)ficlStackPopPointer(vm->dataStack);
+	c.i = patchAddr - dictionary->here;
+
+	ficlDictionaryAppendCell(dictionary, c);
+}
+
+/*
+ * Expect a branch patch address on the param stack,
+ * FICL_VM_STATE_COMPILE a literal offset from the patch location
+ * to the current dictionary location
+ */
+static void
+resolveForwardBranch(ficlDictionary *dictionary, ficlVm *vm, char *tag)
+{
+	ficlInteger offset;
+	ficlCell *patchAddr;
+
+	matchControlTag(vm, tag);
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	patchAddr = (ficlCell *)ficlStackPopPointer(vm->dataStack);
+	offset = dictionary->here - patchAddr;
+	(*patchAddr).i = offset;
+}
+
+/*
+ * Match the tag to the top of the stack. If success,
+ * sopy "here" address into the ficlCell whose address is next
+ * on the stack. Used by do..leave..loop.
+ */
+static void
+resolveAbsBranch(ficlDictionary *dictionary, ficlVm *vm, char *wantTag)
+{
+	ficlCell *patchAddr;
+	char *tag;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 0);
+
+	tag = ficlStackPopPointer(vm->dataStack);
+
+	/*
+	 * Changed the comparison below to compare the pointers first
+	 * (by popular demand)
+	 */
+	if ((tag != wantTag) && strcmp(tag, wantTag)) {
+		ficlVmTextOut(vm, "Warning -- Unmatched control word: ");
+		ficlVmTextOut(vm, wantTag);
+		ficlVmTextOut(vm, "\n");
+	}
+
+	patchAddr = (ficlCell *)ficlStackPopPointer(vm->dataStack);
+	(*patchAddr).p = dictionary->here;
+}
+
+/*
+ * c o l o n   d e f i n i t i o n s
+ * Code to begin compiling a colon definition
+ * This function sets the state to FICL_VM_STATE_COMPILE, then creates a
+ * new word whose name is the next word in the input stream
+ * and whose code is colonParen.
+ */
+static void
+ficlPrimitiveColon(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlString name = ficlVmGetWord(vm);
+
+	vm->state = FICL_VM_STATE_COMPILE;
+	markControlTag(vm, colonTag);
+	ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)ficlInstructionColonParen,
+	    FICL_WORD_DEFAULT | FICL_WORD_SMUDGED);
+
+#if FICL_WANT_LOCALS
+	vm->callback.system->localsCount = 0;
+#endif
+}
+
+static void
+ficlPrimitiveSemicolonCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	matchControlTag(vm, colonTag);
+
+#if FICL_WANT_LOCALS
+	if (vm->callback.system->localsCount > 0) {
+		ficlDictionary *locals;
+		locals = ficlSystemGetLocals(vm->callback.system);
+		ficlDictionaryEmpty(locals, locals->forthWordlist->size);
+		ficlDictionaryAppendUnsigned(dictionary,
+		    ficlInstructionUnlinkParen);
+	}
+	vm->callback.system->localsCount = 0;
+#endif
+
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstructionSemiParen);
+	vm->state = FICL_VM_STATE_INTERPRET;
+	ficlDictionaryUnsmudge(dictionary);
+}
+
+/*
+ * e x i t
+ * CORE
+ * This function simply pops the previous instruction
+ * pointer and returns to the "next" loop. Used for exiting from within
+ * a definition. Note that exitParen is identical to semiParen - they
+ * are in two different functions so that "see" can correctly identify
+ * the end of a colon definition, even if it uses "exit".
+ */
+static void
+ficlPrimitiveExitCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	FICL_IGNORE(vm);
+
+#if FICL_WANT_LOCALS
+	if (vm->callback.system->localsCount > 0) {
+		ficlDictionaryAppendUnsigned(dictionary,
+		    ficlInstructionUnlinkParen);
+	}
+#endif
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstructionExitParen);
+}
+
+/*
+ * c o n s t a n t
+ * IMMEDIATE
+ * Compiles a constant into the dictionary. Constants return their
+ * value when invoked. Expects a value on top of the parm stack.
+ */
+static void
+ficlPrimitiveConstant(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlString name = ficlVmGetWord(vm);
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	ficlDictionaryAppendConstantInstruction(dictionary, name,
+	    ficlInstructionConstantParen, ficlStackPopInteger(vm->dataStack));
+}
+
+static void
+ficlPrimitive2Constant(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlString name = ficlVmGetWord(vm);
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 0);
+
+	ficlDictionaryAppend2ConstantInstruction(dictionary, name,
+	    ficlInstruction2ConstantParen, ficlStackPop2Integer(vm->dataStack));
+}
+
+/*
+ * d i s p l a y C e l l
+ * Drop and print the contents of the ficlCell at the top of the param
+ * stack
+ */
+static void
+ficlPrimitiveDot(ficlVm *vm)
+{
+	ficlCell c;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	c = ficlStackPop(vm->dataStack);
+	ficlLtoa((c).i, vm->pad, vm->base);
+	strcat(vm->pad, " ");
+	ficlVmTextOut(vm, vm->pad);
+}
+
+static void
+ficlPrimitiveUDot(ficlVm *vm)
+{
+	ficlUnsigned u;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	u = ficlStackPopUnsigned(vm->dataStack);
+	ficlUltoa(u, vm->pad, vm->base);
+	strcat(vm->pad, " ");
+	ficlVmTextOut(vm, vm->pad);
+}
+
+static void
+ficlPrimitiveHexDot(ficlVm *vm)
+{
+	ficlUnsigned u;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	u = ficlStackPopUnsigned(vm->dataStack);
+	ficlUltoa(u, vm->pad, 16);
+	strcat(vm->pad, " ");
+	ficlVmTextOut(vm, vm->pad);
+}
+
+/*
+ * s t r l e n
+ * Ficl   ( c-string -- length )
+ *
+ * Returns the length of a C-style (zero-terminated) string.
+ *
+ * --lch
+ */
+static void
+ficlPrimitiveStrlen(ficlVm *vm)
+{
+	char *address = (char *)ficlStackPopPointer(vm->dataStack);
+	ficlStackPushInteger(vm->dataStack, 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 ficlCell 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 (FICL_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
+ficlPrimitiveSprintf(ficlVm *vm)
+{
+	int bufferLength = ficlStackPopInteger(vm->dataStack);
+	char *buffer = (char *)ficlStackPopPointer(vm->dataStack);
+	char *bufferStart = buffer;
+
+	int formatLength = ficlStackPopInteger(vm->dataStack);
+	char *format = (char *)ficlStackPopPointer(vm->dataStack);
+	char *formatStop = format + formatLength;
+
+	int base = 10;
+	int unsignedInteger = 0; /* false */
+
+	int append = 1; /* 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((unsigned char)*format);
+			if (desiredLength) {
+				desiredLength = strtoul(format, &format, 10);
+				if (format == formatStop)
+					break;
+			} else if (*format == '*') {
+				desiredLength =
+				    ficlStackPopInteger(vm->dataStack);
+
+				format++;
+				if (format == formatStop)
+					break;
+			}
+
+			switch (*format) {
+			case 's':
+			case 'S':
+				actualLength =
+				    ficlStackPopInteger(vm->dataStack);
+				source = (char *)
+				    ficlStackPopPointer(vm->dataStack);
+				break;
+			case 'x':
+			case 'X':
+				base = 16;
+			case 'u':
+			case 'U':
+				unsignedInteger = 1; /* true */
+			case 'd':
+			case 'D': {
+				int integer;
+				integer = ficlStackPopInteger(vm->dataStack);
+				if (unsignedInteger)
+					ficlUltoa(integer, scratch, base);
+				else
+					ficlLtoa(integer, scratch, base);
+				base = 10;
+				unsignedInteger = 0; /* false */
+				source = scratch;
+				actualLength = strlen(scratch);
+				break;
+			}
+			case '%':
+				source = format;
+				actualLength = 1;
+			default:
+				continue;
+			}
+		}
+
+		if (append) {
+			if (!desiredLength)
+				desiredLength = actualLength;
+			if (desiredLength > bufferLength) {
+				append = 0; /* false */
+				desiredLength = bufferLength;
+			}
+			while (desiredLength > actualLength) {
+				*buffer++ = (char)((leadingZeroes) ? '0' : ' ');
+				bufferLength--;
+				desiredLength--;
+			}
+			memcpy(buffer, source, actualLength);
+			buffer += actualLength;
+			bufferLength -= actualLength;
+		}
+
+		format++;
+	}
+
+	ficlStackPushPointer(vm->dataStack, bufferStart);
+	ficlStackPushInteger(vm->dataStack, buffer - bufferStart);
+	ficlStackPushInteger(vm->dataStack, FICL_BOOL(!append));
+}
+
+/*
+ * d u p   &   f r i e n d s
+ */
+static void
+ficlPrimitiveDepth(ficlVm *vm)
+{
+	int i;
+
+	FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+	i = ficlStackDepth(vm->dataStack);
+	ficlStackPushInteger(vm->dataStack, i);
+}
+
+/*
+ * e m i t   &   f r i e n d s
+ */
+static void
+ficlPrimitiveEmit(ficlVm *vm)
+{
+	char buffer[2];
+	int i;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	i = ficlStackPopInteger(vm->dataStack);
+	buffer[0] = (char)i;
+	buffer[1] = '\0';
+	ficlVmTextOut(vm, buffer);
+}
+
+static void
+ficlPrimitiveCR(ficlVm *vm)
+{
+	ficlVmTextOut(vm, "\n");
+}
+
+static void
+ficlPrimitiveBackslash(ficlVm *vm)
+{
+	char *trace = ficlVmGetInBuf(vm);
+	char *stop = ficlVmGetInBufEnd(vm);
+	char c = *trace;
+
+	while ((trace != stop) && (c != '\r') && (c != '\n')) {
+		c = *++trace;
+	}
+
+	/*
+	 * Cope with DOS or UNIX-style EOLs -
+	 * Check for /r, /n, /r/n, or /n/r end-of-line sequences,
+	 * and point trace to next char. If EOL is \0, we're done.
+	 */
+	if (trace != stop) {
+		trace++;
+
+		if ((trace != stop) && (c != *trace) &&
+		    ((*trace == '\r') || (*trace == '\n')))
+			trace++;
+	}
+
+	ficlVmUpdateTib(vm, trace);
+}
+
+/*
+ * paren CORE
+ * Compilation: Perform the execution semantics given below.
+ * Execution: ( "ccc<paren>" -- )
+ * Parse ccc delimited by ) (right parenthesis). ( is an immediate word.
+ * The number of characters in ccc may be zero to the number of characters
+ * in the parse area.
+ */
+static void
+ficlPrimitiveParenthesis(ficlVm *vm)
+{
+	ficlVmParseStringEx(vm, ')', 0);
+}
+
+/*
+ * F E T C H   &   S T O R E
+ */
+
+/*
+ * i f C o I m
+ * IMMEDIATE
+ * Compiles code for a conditional branch into the dictionary
+ * and pushes the branch patch address on the stack for later
+ * patching by ELSE or THEN/ENDIF.
+ */
+static void
+ficlPrimitiveIfCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionBranch0ParenWithCheck);
+	markBranch(dictionary, vm, origTag);
+	ficlDictionaryAppendUnsigned(dictionary, 1);
+}
+
+/*
+ * e l s e C o I m
+ *
+ * IMMEDIATE -- compiles an "else"...
+ * 1) FICL_VM_STATE_COMPILE a branch and a patch address;
+ *    the address gets patched
+ *    by "endif" to point past the "else" code.
+ * 2) Pop the the "if" patch address
+ * 3) Patch the "if" branch to point to the current FICL_VM_STATE_COMPILE
+ *    address.
+ * 4) Push the "else" patch address. ("endif" patches this to jump past
+ *    the "else" code.
+ */
+static void
+ficlPrimitiveElseCoIm(ficlVm *vm)
+{
+	ficlCell *patchAddr;
+	ficlInteger offset;
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	/* (1) FICL_VM_STATE_COMPILE branch runtime */
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionBranchParenWithCheck);
+
+	matchControlTag(vm, origTag);
+						/* (2) pop "if" patch addr */
+	patchAddr = (ficlCell *)ficlStackPopPointer(vm->dataStack);
+	markBranch(dictionary, vm, origTag);	/* (4) push "else" patch addr */
+
+			/* (1) FICL_VM_STATE_COMPILE patch placeholder */
+	ficlDictionaryAppendUnsigned(dictionary, 1);
+	offset = dictionary->here - patchAddr;
+	(*patchAddr).i = offset;		/* (3) Patch "if" */
+}
+
+/*
+ * e n d i f C o I m
+ */
+static void
+ficlPrimitiveEndifCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	resolveForwardBranch(dictionary, vm, origTag);
+}
+
+/*
+ * c a s e C o I m
+ * IMMEDIATE FICL_VM_STATE_COMPILE-ONLY
+ *
+ *
+ * At FICL_VM_STATE_COMPILE-time, a CASE-SYS (see DPANS94 6.2.0873) looks
+ * like this:
+ *			i*addr i caseTag
+ * and an OF-SYS (see DPANS94 6.2.1950) looks like this:
+ *			i*addr i caseTag addr ofTag
+ * The integer under caseTag is the count of fixup addresses that branch
+ * to ENDCASE.
+ */
+static void
+ficlPrimitiveCaseCoIm(ficlVm *vm)
+{
+	FICL_STACK_CHECK(vm->dataStack, 0, 2);
+
+	ficlStackPushUnsigned(vm->dataStack, 0);
+	markControlTag(vm, caseTag);
+}
+
+/*
+ * e n d c a s eC o I m
+ * IMMEDIATE FICL_VM_STATE_COMPILE-ONLY
+ */
+static void
+ficlPrimitiveEndcaseCoIm(ficlVm *vm)
+{
+	ficlUnsigned fixupCount;
+	ficlDictionary *dictionary;
+	ficlCell *patchAddr;
+	ficlInteger offset;
+
+	/*
+	 * if the last OF ended with FALLTHROUGH,
+	 * just add the FALLTHROUGH fixup to the
+	 * ENDOF fixups
+	 */
+	if (ficlStackGetTop(vm->dataStack).p == fallthroughTag) {
+		matchControlTag(vm, fallthroughTag);
+		patchAddr = ficlStackPopPointer(vm->dataStack);
+		matchControlTag(vm, caseTag);
+		fixupCount = ficlStackPopUnsigned(vm->dataStack);
+		ficlStackPushPointer(vm->dataStack, patchAddr);
+		ficlStackPushUnsigned(vm->dataStack, fixupCount + 1);
+		markControlTag(vm, caseTag);
+	}
+
+	matchControlTag(vm, caseTag);
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	fixupCount = ficlStackPopUnsigned(vm->dataStack);
+	FICL_STACK_CHECK(vm->dataStack, fixupCount, 0);
+
+	dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstructionDrop);
+
+	while (fixupCount--) {
+		patchAddr = (ficlCell *)ficlStackPopPointer(vm->dataStack);
+		offset = dictionary->here - patchAddr;
+		(*patchAddr).i = offset;
+	}
+}
+
+/*
+ * o f C o I m
+ * IMMEDIATE FICL_VM_STATE_COMPILE-ONLY
+ */
+static void
+ficlPrimitiveOfCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlCell *fallthroughFixup = NULL;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 3);
+
+	if (ficlStackGetTop(vm->dataStack).p == fallthroughTag) {
+		matchControlTag(vm, fallthroughTag);
+		fallthroughFixup = ficlStackPopPointer(vm->dataStack);
+	}
+
+	matchControlTag(vm, caseTag);
+
+	markControlTag(vm, caseTag);
+
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstructionOfParen);
+	markBranch(dictionary, vm, ofTag);
+	ficlDictionaryAppendUnsigned(dictionary, 2);
+
+	if (fallthroughFixup != NULL) {
+		ficlInteger offset = dictionary->here - fallthroughFixup;
+		(*fallthroughFixup).i = offset;
+	}
+}
+
+/*
+ * e n d o f C o I m
+ * IMMEDIATE FICL_VM_STATE_COMPILE-ONLY
+ */
+static void
+ficlPrimitiveEndofCoIm(ficlVm *vm)
+{
+	ficlCell *patchAddr;
+	ficlUnsigned fixupCount;
+	ficlInteger offset;
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	FICL_STACK_CHECK(vm->dataStack, 4, 3);
+
+	/* ensure we're in an OF, */
+	matchControlTag(vm, ofTag);
+
+	/* grab the address of the branch location after the OF */
+	patchAddr = (ficlCell *)ficlStackPopPointer(vm->dataStack);
+	/* ensure we're also in a "case" */
+	matchControlTag(vm, caseTag);
+	/* grab the current number of ENDOF fixups */
+	fixupCount = ficlStackPopUnsigned(vm->dataStack);
+
+	/* FICL_VM_STATE_COMPILE branch runtime */
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionBranchParenWithCheck);
+
+	/*
+	 * push a new ENDOF fixup, the updated count of ENDOF fixups,
+	 * and the caseTag
+	 */
+	ficlStackPushPointer(vm->dataStack, dictionary->here);
+	ficlStackPushUnsigned(vm->dataStack, fixupCount + 1);
+	markControlTag(vm, caseTag);
+
+	/* reserve space for the ENDOF fixup */
+	ficlDictionaryAppendUnsigned(dictionary, 2);
+
+	/* and patch the original OF */
+	offset = dictionary->here - patchAddr;
+	(*patchAddr).i = offset;
+}
+
+/*
+ * f a l l t h r o u g h C o I m
+ * IMMEDIATE FICL_VM_STATE_COMPILE-ONLY
+ */
+static void
+ficlPrimitiveFallthroughCoIm(ficlVm *vm)
+{
+	ficlCell *patchAddr;
+	ficlInteger offset;
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	FICL_STACK_CHECK(vm->dataStack, 4, 3);
+
+	/* ensure we're in an OF, */
+	matchControlTag(vm, ofTag);
+	/* grab the address of the branch location after the OF */
+	patchAddr = (ficlCell *)ficlStackPopPointer(vm->dataStack);
+	/* ensure we're also in a "case" */
+	matchControlTag(vm, caseTag);
+
+	/* okay, here we go.  put the case tag back. */
+	markControlTag(vm, caseTag);
+
+	/* FICL_VM_STATE_COMPILE branch runtime */
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionBranchParenWithCheck);
+
+	/* push a new FALLTHROUGH fixup and the fallthroughTag */
+	ficlStackPushPointer(vm->dataStack, dictionary->here);
+	markControlTag(vm, fallthroughTag);
+
+	/* reserve space for the FALLTHROUGH fixup */
+	ficlDictionaryAppendUnsigned(dictionary, 2);
+
+	/* and patch the original OF */
+	offset = dictionary->here - patchAddr;
+	(*patchAddr).i = offset;
+}
+
+/*
+ * h a s h
+ * hash ( c-addr u -- code)
+ * calculates hashcode of specified string and leaves it on the stack
+ */
+static void
+ficlPrimitiveHash(ficlVm *vm)
+{
+	ficlString s;
+
+	FICL_STRING_SET_LENGTH(s, ficlStackPopUnsigned(vm->dataStack));
+	FICL_STRING_SET_POINTER(s, ficlStackPopPointer(vm->dataStack));
+	ficlStackPushUnsigned(vm->dataStack, ficlHashCode(s));
+}
+
+/*
+ * i n t e r p r e t
+ * This is the "user interface" of a Forth. It does the following:
+ *   while there are words in the VM's Text Input Buffer
+ *     Copy next word into the pad (ficlVmGetWord)
+ *     Attempt to find the word in the dictionary (ficlDictionaryLookup)
+ *     If successful, execute the word.
+ *     Otherwise, attempt to convert the word to a number (isNumber)
+ *     If successful, push the number onto the parameter stack.
+ *     Otherwise, print an error message and exit loop...
+ *   End Loop
+ *
+ * From the standard, section 3.4
+ * Text interpretation (see 6.1.1360 EVALUATE and 6.1.2050 QUIT) shall
+ * repeat the following steps until either the parse area is empty or an
+ * ambiguous condition exists:
+ * a) Skip leading spaces and parse a name (see 3.4.1);
+ */
+static void
+ficlPrimitiveInterpret(ficlVm *vm)
+{
+	ficlString s;
+	int i;
+	ficlSystem *system;
+
+	FICL_VM_ASSERT(vm, vm);
+
+	system = vm->callback.system;
+	s = ficlVmGetWord0(vm);
+
+	/*
+	 * Get next word...if out of text, we're done.
+	 */
+	if (s.length == 0) {
+		ficlVmThrow(vm, FICL_VM_STATUS_OUT_OF_TEXT);
+	}
+
+	/*
+	 * Run the parse chain against the incoming token until somebody
+	 * eats it. Otherwise emit an error message and give up.
+	 */
+	for (i = 0; i < FICL_MAX_PARSE_STEPS; i++) {
+		ficlWord *word = system->parseList[i];
+
+		if (word == NULL)
+			break;
+
+		if (word->code == ficlPrimitiveParseStepParen) {
+			ficlParseStep pStep;
+			pStep = (ficlParseStep)(word->param->fn);
+			if ((*pStep)(vm, s))
+				return;
+		} else {
+			ficlStackPushPointer(vm->dataStack,
+			    FICL_STRING_GET_POINTER(s));
+			ficlStackPushUnsigned(vm->dataStack,
+			    FICL_STRING_GET_LENGTH(s));
+			ficlVmExecuteXT(vm, word);
+			if (ficlStackPopInteger(vm->dataStack))
+				return;
+		}
+	}
+
+	ficlVmThrowError(vm, "%.*s not found", FICL_STRING_GET_LENGTH(s),
+	    FICL_STRING_GET_POINTER(s));
+	/* back to inner interpreter */
+}
+
+/*
+ * Surrogate precompiled parse step for ficlParseWord
+ * (this step is hard coded in FICL_VM_STATE_INTERPRET)
+ */
+static void
+ficlPrimitiveLookup(ficlVm *vm)
+{
+	ficlString name;
+	FICL_STRING_SET_LENGTH(name, ficlStackPopUnsigned(vm->dataStack));
+	FICL_STRING_SET_POINTER(name, ficlStackPopPointer(vm->dataStack));
+	ficlStackPushInteger(vm->dataStack, ficlVmParseWord(vm, name));
+}
+
+/*
+ * p a r e n P a r s e S t e p
+ * (parse-step)  ( c-addr u -- flag )
+ * runtime for a precompiled parse step - pop a counted string off the
+ * stack, run the parse step against it, and push the result flag (FICL_TRUE
+ * if success, FICL_FALSE otherwise).
+ */
+void
+ficlPrimitiveParseStepParen(ficlVm *vm)
+{
+	ficlString s;
+	ficlWord *word = vm->runningWord;
+	ficlParseStep pStep = (ficlParseStep)(word->param->fn);
+
+	FICL_STRING_SET_LENGTH(s, ficlStackPopInteger(vm->dataStack));
+	FICL_STRING_SET_POINTER(s, ficlStackPopPointer(vm->dataStack));
+
+	ficlStackPushInteger(vm->dataStack, (*pStep)(vm, s));
+}
+
+static void
+ficlPrimitiveAddParseStep(ficlVm *vm)
+{
+	ficlWord *pStep;
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	pStep = (ficlWord *)(ficlStackPop(vm->dataStack).p);
+	if ((pStep != NULL) && ficlDictionaryIsAWord(dictionary, pStep))
+		ficlSystemAddParseStep(vm->callback.system, pStep);
+}
+
+/*
+ * l i t e r a l I m
+ *
+ * IMMEDIATE code for "literal". This function gets a value from the stack
+ * and compiles it into the dictionary preceded by the code for "(literal)".
+ * IMMEDIATE
+ */
+void
+ficlPrimitiveLiteralIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlInteger value;
+
+	value = ficlStackPopInteger(vm->dataStack);
+
+	switch (value) {
+	case 1:
+	case 2:
+	case 3:
+	case 4:
+	case 5:
+	case 6:
+	case 7:
+	case 8:
+	case 9:
+	case 10:
+	case 11:
+	case 12:
+	case 13:
+	case 14:
+	case 15:
+	case 16:
+		ficlDictionaryAppendUnsigned(dictionary, value);
+		break;
+
+	case 0:
+	case -1:
+	case -2:
+	case -3:
+	case -4:
+	case -5:
+	case -6:
+	case -7:
+	case -8:
+	case -9:
+	case -10:
+	case -11:
+	case -12:
+	case -13:
+	case -14:
+	case -15:
+	case -16:
+		ficlDictionaryAppendUnsigned(dictionary,
+		    ficlInstruction0 - value);
+	break;
+
+	default:
+		ficlDictionaryAppendUnsigned(dictionary,
+		    ficlInstructionLiteralParen);
+		ficlDictionaryAppendUnsigned(dictionary, value);
+	break;
+	}
+}
+
+static void
+ficlPrimitive2LiteralIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstruction2LiteralParen);
+	ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->dataStack));
+	ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->dataStack));
+}
+
+/*
+ * D o  /  L o o p
+ * do -- IMMEDIATE FICL_VM_STATE_COMPILE ONLY
+ *    Compiles code to initialize a loop: FICL_VM_STATE_COMPILE (do),
+ *    allot space to hold the "leave" address, push a branch
+ *    target address for the loop.
+ * (do) -- runtime for "do"
+ *    pops index and limit from the p stack and moves them
+ *    to the r stack, then skips to the loop body.
+ * loop -- IMMEDIATE FICL_VM_STATE_COMPILE ONLY
+ * +loop
+ *    Compiles code for the test part of a loop:
+ *    FICL_VM_STATE_COMPILE (loop), resolve forward branch from "do", and
+ *    copy "here" address to the "leave" address allotted by "do"
+ * i,j,k -- FICL_VM_STATE_COMPILE ONLY
+ *    Runtime: Push loop indices on param stack (i is innermost loop...)
+ *    Note: each loop has three values on the return stack:
+ *    ( R: leave limit index )
+ *    "leave" is the absolute address of the next ficlCell after the loop
+ *    limit and index are the loop control variables.
+ * leave -- FICL_VM_STATE_COMPILE ONLY
+ *    Runtime: pop the loop control variables, then pop the
+ *    "leave" address and jump (absolute) there.
+ */
+static void
+ficlPrimitiveDoCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstructionDoParen);
+	/*
+	 * Allot space for a pointer to the end
+	 * of the loop - "leave" uses this...
+	 */
+	markBranch(dictionary, vm, leaveTag);
+	ficlDictionaryAppendUnsigned(dictionary, 0);
+	/*
+	 * Mark location of head of loop...
+	 */
+	markBranch(dictionary, vm, doTag);
+}
+
+static void
+ficlPrimitiveQDoCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstructionQDoParen);
+	/*
+	 * Allot space for a pointer to the end
+	 * of the loop - "leave" uses this...
+	 */
+	markBranch(dictionary, vm, leaveTag);
+	ficlDictionaryAppendUnsigned(dictionary, 0);
+	/*
+	 * Mark location of head of loop...
+	 */
+	markBranch(dictionary, vm, doTag);
+}
+
+
+static void
+ficlPrimitiveLoopCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstructionLoopParen);
+	resolveBackBranch(dictionary, vm, doTag);
+	resolveAbsBranch(dictionary, vm, leaveTag);
+}
+
+static void
+ficlPrimitivePlusLoopCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstructionPlusLoopParen);
+	resolveBackBranch(dictionary, vm, doTag);
+	resolveAbsBranch(dictionary, vm, leaveTag);
+}
+
+/*
+ * v a r i a b l e
+ */
+static void
+ficlPrimitiveVariable(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlString name = ficlVmGetWord(vm);
+
+	ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)ficlInstructionVariableParen, FICL_WORD_DEFAULT);
+	ficlVmDictionaryAllotCells(vm, dictionary, 1);
+}
+
+static void
+ficlPrimitive2Variable(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlString name = ficlVmGetWord(vm);
+
+	ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)ficlInstructionVariableParen, FICL_WORD_DEFAULT);
+	ficlVmDictionaryAllotCells(vm, dictionary, 2);
+}
+
+/*
+ * b a s e   &   f r i e n d s
+ */
+static void
+ficlPrimitiveBase(ficlVm *vm)
+{
+	ficlCell *pBase, c;
+
+	FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+	pBase = (ficlCell *)(&vm->base);
+	c.p = pBase;
+	ficlStackPush(vm->dataStack, c);
+}
+
+static void
+ficlPrimitiveDecimal(ficlVm *vm)
+{
+	vm->base = 10;
+}
+
+
+static void
+ficlPrimitiveHex(ficlVm *vm)
+{
+	vm->base = 16;
+}
+
+/*
+ * a l l o t   &   f r i e n d s
+ */
+static void
+ficlPrimitiveAllot(ficlVm *vm)
+{
+	ficlDictionary *dictionary;
+	ficlInteger i;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	dictionary = ficlVmGetDictionary(vm);
+	i = ficlStackPopInteger(vm->dataStack);
+
+	FICL_VM_DICTIONARY_CHECK(vm, dictionary, i);
+
+	ficlVmDictionaryAllot(vm, dictionary, i);
+}
+
+static void
+ficlPrimitiveHere(ficlVm *vm)
+{
+	ficlDictionary *dictionary;
+
+	FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+	dictionary = ficlVmGetDictionary(vm);
+	ficlStackPushPointer(vm->dataStack, dictionary->here);
+}
+
+/*
+ * t i c k
+ * tick         CORE ( "<spaces>name" -- xt )
+ * Skip leading space delimiters. Parse name delimited by a space. Find
+ * name and return xt, the execution token for name. An ambiguous condition
+ * exists if name is not found.
+ */
+void
+ficlPrimitiveTick(ficlVm *vm)
+{
+	ficlWord *word = NULL;
+	ficlString name = ficlVmGetWord(vm);
+
+	FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+	word = ficlDictionaryLookup(ficlVmGetDictionary(vm), name);
+	if (!word)
+		ficlVmThrowError(vm, "%.*s not found",
+		    FICL_STRING_GET_LENGTH(name),
+		    FICL_STRING_GET_POINTER(name));
+	ficlStackPushPointer(vm->dataStack, word);
+}
+
+static void
+ficlPrimitiveBracketTickCoIm(ficlVm *vm)
+{
+	ficlPrimitiveTick(vm);
+	ficlPrimitiveLiteralIm(vm);
+}
+
+/*
+ * p o s t p o n e
+ * Lookup the next word in the input stream and FICL_VM_STATE_COMPILE code to
+ * insert it into definitions created by the resulting word
+ * (defers compilation, even of immediate words)
+ */
+static void
+ficlPrimitivePostponeCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary  = ficlVmGetDictionary(vm);
+	ficlWord *word;
+	ficlWord *pComma = ficlSystemLookup(vm->callback.system, ",");
+	ficlCell c;
+
+	FICL_VM_ASSERT(vm, pComma);
+
+	ficlPrimitiveTick(vm);
+	word = ficlStackGetTop(vm->dataStack).p;
+	if (ficlWordIsImmediate(word)) {
+		ficlDictionaryAppendCell(dictionary,
+		    ficlStackPop(vm->dataStack));
+	} else {
+		ficlPrimitiveLiteralIm(vm);
+		c.p = pComma;
+		ficlDictionaryAppendCell(dictionary, c);
+	}
+}
+
+/*
+ * e x e c u t e
+ * Pop an execution token (pointer to a word) off the stack and
+ * run it
+ */
+static void
+ficlPrimitiveExecute(ficlVm *vm)
+{
+	ficlWord *word;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	word = ficlStackPopPointer(vm->dataStack);
+	ficlVmExecuteWord(vm, word);
+}
+
+/*
+ * i m m e d i a t e
+ * Make the most recently compiled word IMMEDIATE -- it executes even
+ * in FICL_VM_STATE_COMPILE state (most often used for control compiling words
+ * such as IF, THEN, etc)
+ */
+static void
+ficlPrimitiveImmediate(ficlVm *vm)
+{
+	FICL_IGNORE(vm);
+	ficlDictionarySetImmediate(ficlVmGetDictionary(vm));
+}
+
+static void
+ficlPrimitiveCompileOnly(ficlVm *vm)
+{
+	FICL_IGNORE(vm);
+	ficlDictionarySetFlags(ficlVmGetDictionary(vm), FICL_WORD_COMPILE_ONLY);
+}
+
+static void
+ficlPrimitiveSetObjectFlag(ficlVm *vm)
+{
+	FICL_IGNORE(vm);
+	ficlDictionarySetFlags(ficlVmGetDictionary(vm), FICL_WORD_OBJECT);
+}
+
+static void
+ficlPrimitiveIsObject(ficlVm *vm)
+{
+	ficlInteger flag;
+	ficlWord *word = (ficlWord *)ficlStackPopPointer(vm->dataStack);
+
+	flag = ((word != NULL) && (word->flags & FICL_WORD_OBJECT))?
+	    FICL_TRUE : FICL_FALSE;
+
+	ficlStackPushInteger(vm->dataStack, flag);
+}
+
+static void
+ficlPrimitiveCountedStringQuoteIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	if (vm->state == FICL_VM_STATE_INTERPRET) {
+		ficlCountedString *counted = (ficlCountedString *)
+		    dictionary->here;
+
+		ficlVmGetString(vm, counted, '\"');
+		ficlStackPushPointer(vm->dataStack, counted);
+
+		/*
+		 * move HERE past string so it doesn't get overwritten.  --lch
+		 */
+		ficlVmDictionaryAllot(vm, dictionary,
+		    counted->length + sizeof (ficlUnsigned8));
+	} else {	/* FICL_VM_STATE_COMPILE state */
+		ficlDictionaryAppendUnsigned(dictionary,
+		    ficlInstructionCStringLiteralParen);
+		dictionary->here =
+		    FICL_POINTER_TO_CELL(ficlVmGetString(vm,
+		    (ficlCountedString *)dictionary->here, '\"'));
+		ficlDictionaryAlign(dictionary);
+	}
+}
+
+/*
+ * d o t Q u o t e
+ * IMMEDIATE word that compiles a string literal for later display
+ * FICL_VM_STATE_COMPILE fiStringLiteralParen, then copy the bytes of the
+ * string from the
+ * TIB to the dictionary. Backpatch the count byte and align the dictionary.
+ */
+static void
+ficlPrimitiveDotQuoteCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlWord *pType = ficlSystemLookup(vm->callback.system, "type");
+	ficlCell c;
+
+	FICL_VM_ASSERT(vm, pType);
+
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionStringLiteralParen);
+	dictionary->here =
+	    FICL_POINTER_TO_CELL(ficlVmGetString(vm,
+	    (ficlCountedString *)dictionary->here, '\"'));
+	ficlDictionaryAlign(dictionary);
+	c.p = pType;
+	ficlDictionaryAppendCell(dictionary, c);
+}
+
+static void
+ficlPrimitiveDotParen(ficlVm *vm)
+{
+	char *from = ficlVmGetInBuf(vm);
+	char *stop = ficlVmGetInBufEnd(vm);
+	char *to = vm->pad;
+	char c;
+
+	/*
+	 * Note: the standard does not want leading spaces skipped.
+	 */
+	for (c = *from; (from != stop) && (c != ')'); c = *++from)
+		*to++ = c;
+
+	*to = '\0';
+	if ((from != stop) && (c == ')'))
+		from++;
+
+	ficlVmTextOut(vm, vm->pad);
+	ficlVmUpdateTib(vm, from);
+}
+
+/*
+ * s l i t e r a l
+ * STRING
+ * Interpretation: Interpretation semantics for this word are undefined.
+ * Compilation: ( c-addr1 u -- )
+ * Append the run-time semantics given below to the current definition.
+ * Run-time:       ( -- c-addr2 u )
+ * Return c-addr2 u describing a string consisting of the characters
+ * specified by c-addr1 u during compilation. A program shall not alter
+ * the returned string.
+ */
+static void ficlPrimitiveSLiteralCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary;
+	char *from;
+	char *to;
+	ficlUnsigned length;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 0);
+
+	dictionary = ficlVmGetDictionary(vm);
+	length  = ficlStackPopUnsigned(vm->dataStack);
+	from = ficlStackPopPointer(vm->dataStack);
+
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionStringLiteralParen);
+	to = (char *)dictionary->here;
+	*to++ = (char)length;
+
+	for (; length > 0; --length) {
+		*to++ = *from++;
+	}
+
+	*to++ = 0;
+	dictionary->here = FICL_POINTER_TO_CELL(ficlAlignPointer(to));
+}
+
+/*
+ * s t a t e
+ * Return the address of the VM's state member (must be sized the
+ * same as a ficlCell for this reason)
+ */
+static void ficlPrimitiveState(ficlVm *vm)
+{
+	FICL_STACK_CHECK(vm->dataStack, 0, 1);
+	ficlStackPushPointer(vm->dataStack, &vm->state);
+}
+
+/*
+ * c r e a t e . . . d o e s >
+ * Make a new word in the dictionary with the run-time effect of
+ * a variable (push my address), but with extra space allotted
+ * for use by does> .
+ */
+static void
+ficlPrimitiveCreate(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlString name = ficlVmGetWord(vm);
+
+	ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)ficlInstructionCreateParen, FICL_WORD_DEFAULT);
+	ficlVmDictionaryAllotCells(vm, dictionary, 1);
+}
+
+static void
+ficlPrimitiveDoesCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+#if FICL_WANT_LOCALS
+	if (vm->callback.system->localsCount > 0) {
+		ficlDictionary *locals =
+		    ficlSystemGetLocals(vm->callback.system);
+		ficlDictionaryEmpty(locals, locals->forthWordlist->size);
+		ficlDictionaryAppendUnsigned(dictionary,
+		    ficlInstructionUnlinkParen);
+	}
+
+	vm->callback.system->localsCount = 0;
+#endif
+	FICL_IGNORE(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary, ficlInstructionDoesParen);
+}
+
+/*
+ * t o   b o d y
+ * to-body	CORE ( xt -- a-addr )
+ * a-addr is the data-field address corresponding to xt. An ambiguous
+ * condition exists if xt is not for a word defined via CREATE.
+ */
+static void
+ficlPrimitiveToBody(ficlVm *vm)
+{
+	ficlWord *word;
+	FICL_STACK_CHECK(vm->dataStack, 1, 1);
+
+	word = ficlStackPopPointer(vm->dataStack);
+	ficlStackPushPointer(vm->dataStack, word->param + 1);
+}
+
+/*
+ * from-body	Ficl ( a-addr -- xt )
+ * Reverse effect of >body
+ */
+static void
+ficlPrimitiveFromBody(ficlVm *vm)
+{
+	char *ptr;
+	FICL_STACK_CHECK(vm->dataStack, 1, 1);
+
+	ptr = (char *)ficlStackPopPointer(vm->dataStack) - sizeof (ficlWord);
+	ficlStackPushPointer(vm->dataStack, ptr);
+}
+
+/*
+ * >name	Ficl ( xt -- c-addr u )
+ * Push the address and length of a word's name given its address
+ * xt.
+ */
+static void
+ficlPrimitiveToName(ficlVm *vm)
+{
+	ficlWord *word;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 2);
+
+	word = ficlStackPopPointer(vm->dataStack);
+	ficlStackPushPointer(vm->dataStack, word->name);
+	ficlStackPushUnsigned(vm->dataStack, word->length);
+}
+
+static void
+ficlPrimitiveLastWord(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlWord *wp = dictionary->smudge;
+	ficlCell c;
+
+	FICL_VM_ASSERT(vm, wp);
+
+	c.p = wp;
+	ficlVmPush(vm, c);
+}
+
+/*
+ * l b r a c k e t   e t c
+ */
+static void
+ficlPrimitiveLeftBracketCoIm(ficlVm *vm)
+{
+	vm->state = FICL_VM_STATE_INTERPRET;
+}
+
+static void
+ficlPrimitiveRightBracket(ficlVm *vm)
+{
+	vm->state = FICL_VM_STATE_COMPILE;
+}
+
+/*
+ * p i c t u r e d   n u m e r i c   w o r d s
+ *
+ * less-number-sign CORE ( -- )
+ * Initialize the pictured numeric output conversion process.
+ * (clear the pad)
+ */
+static void
+ficlPrimitiveLessNumberSign(ficlVm *vm)
+{
+	ficlCountedString *counted = FICL_POINTER_TO_COUNTED_STRING(vm->pad);
+	counted->length = 0;
+}
+
+/*
+ * number-sign		CORE ( ud1 -- ud2 )
+ * Divide ud1 by the number in BASE giving the quotient ud2 and the remainder
+ * n. (n is the least-significant digit of ud1.) Convert n to external form
+ * and add the resulting character to the beginning of the pictured numeric
+ * output  string. An ambiguous condition exists if # executes outside of a
+ * <# #> delimited number conversion.
+ */
+static void
+ficlPrimitiveNumberSign(ficlVm *vm)
+{
+	ficlCountedString *counted;
+	ficl2Unsigned u;
+	ficl2UnsignedQR uqr;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 2);
+
+	counted = FICL_POINTER_TO_COUNTED_STRING(vm->pad);
+	u = ficlStackPop2Unsigned(vm->dataStack);
+	uqr = ficl2UnsignedDivide(u, (ficlUnsigned16)(vm->base));
+	counted->text[counted->length++] = ficlDigitToCharacter(uqr.remainder);
+	ficlStackPush2Unsigned(vm->dataStack, uqr.quotient);
+}
+
+/*
+ * number-sign-greater CORE ( xd -- c-addr u )
+ * Drop xd. Make the pictured numeric output string available as a character
+ * string. c-addr and u specify the resulting character string. A program
+ * may replace characters within the string.
+ */
+static void
+ficlPrimitiveNumberSignGreater(ficlVm *vm)
+{
+	ficlCountedString *counted;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 2);
+
+	counted = FICL_POINTER_TO_COUNTED_STRING(vm->pad);
+	counted->text[counted->length] = 0;
+	ficlStringReverse(counted->text);
+	ficlStackDrop(vm->dataStack, 2);
+	ficlStackPushPointer(vm->dataStack, counted->text);
+	ficlStackPushUnsigned(vm->dataStack, counted->length);
+}
+
+/*
+ * number-sign-s	CORE ( ud1 -- ud2 )
+ * Convert one digit of ud1 according to the rule for #. Continue conversion
+ * until the quotient is zero. ud2 is zero. An ambiguous condition exists if
+ * #S executes outside of a <# #> delimited number conversion.
+ * TO DO: presently does not use ud1 hi ficlCell - use it!
+ */
+static void
+ficlPrimitiveNumberSignS(ficlVm *vm)
+{
+	ficlCountedString *counted;
+	ficl2Unsigned u;
+	ficl2UnsignedQR uqr;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 2);
+
+	counted = FICL_POINTER_TO_COUNTED_STRING(vm->pad);
+	u = ficlStackPop2Unsigned(vm->dataStack);
+
+	do {
+		uqr = ficl2UnsignedDivide(u, (ficlUnsigned16)(vm->base));
+		counted->text[counted->length++] =
+		    ficlDigitToCharacter(uqr.remainder);
+		u = uqr.quotient;
+	} while (FICL_2UNSIGNED_NOT_ZERO(u));
+
+	ficlStackPush2Unsigned(vm->dataStack, u);
+}
+
+/*
+ * HOLD		CORE ( char -- )
+ * Add char to the beginning of the pictured numeric output string.
+ * An ambiguous condition exists if HOLD executes outside of a <# #>
+ * delimited number conversion.
+ */
+static void
+ficlPrimitiveHold(ficlVm *vm)
+{
+	ficlCountedString *counted;
+	int i;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	counted = FICL_POINTER_TO_COUNTED_STRING(vm->pad);
+	i = ficlStackPopInteger(vm->dataStack);
+	counted->text[counted->length++] = (char)i;
+}
+
+/*
+ * SIGN		CORE ( n -- )
+ * If n is negative, add a minus sign to the beginning of the pictured
+ * numeric output string. An ambiguous condition exists if SIGN
+ * executes outside of a <# #> delimited number conversion.
+ */
+static void
+ficlPrimitiveSign(ficlVm *vm)
+{
+	ficlCountedString *counted;
+	int i;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	counted = FICL_POINTER_TO_COUNTED_STRING(vm->pad);
+	i = ficlStackPopInteger(vm->dataStack);
+	if (i < 0)
+		counted->text[counted->length++] = '-';
+}
+
+/*
+ * t o   N u m b e r
+ * to-number CORE ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 )
+ * ud2 is the unsigned result of converting the characters within the
+ * string specified by c-addr1 u1 into digits, using the number in BASE,
+ * and adding each into ud1 after multiplying ud1 by the number in BASE.
+ * Conversion continues left-to-right until a character that is not
+ * convertible, including any + or -, is encountered or the string is
+ * entirely converted. c-addr2 is the location of the first unconverted
+ * character or the first character past the end of the string if the string
+ * was entirely converted. u2 is the number of unconverted characters in the
+ * string. An ambiguous condition exists if ud2 overflows during the
+ * conversion.
+ */
+static void
+ficlPrimitiveToNumber(ficlVm *vm)
+{
+	ficlUnsigned length;
+	char *trace;
+	ficl2Unsigned accumulator;
+	ficlUnsigned base = vm->base;
+	ficlUnsigned c;
+	ficlUnsigned digit;
+
+	FICL_STACK_CHECK(vm->dataStack, 4, 4);
+
+	length = ficlStackPopUnsigned(vm->dataStack);
+	trace = (char *)ficlStackPopPointer(vm->dataStack);
+	accumulator = ficlStackPop2Unsigned(vm->dataStack);
+
+	for (c = *trace; length > 0; c = *++trace, length--) {
+		if (c < '0')
+			break;
+
+		digit = c - '0';
+
+		if (digit > 9)
+			digit = tolower(c) - 'a' + 10;
+		/*
+		 * Note: following test also catches chars between 9 and a
+		 * because 'digit' is unsigned!
+		 */
+		if (digit >= base)
+			break;
+
+		accumulator = ficl2UnsignedMultiplyAccumulate(accumulator,
+		    base, digit);
+	}
+
+	ficlStackPush2Unsigned(vm->dataStack, accumulator);
+	ficlStackPushPointer(vm->dataStack, trace);
+	ficlStackPushUnsigned(vm->dataStack, length);
+}
+
+/*
+ * q u i t   &   a b o r t
+ * quit CORE	( -- )  ( R:  i*x -- )
+ * Empty the return stack, store zero in SOURCE-ID if it is present, make
+ * the user input device the input source, and enter interpretation state.
+ * Do not display a message. Repeat the following:
+ *
+ *   Accept a line from the input source into the input buffer, set >IN to
+ *   zero, and FICL_VM_STATE_INTERPRET.
+ *   Display the implementation-defined system prompt if in
+ *   interpretation state, all processing has been completed, and no
+ *   ambiguous condition exists.
+ */
+static void
+ficlPrimitiveQuit(ficlVm *vm)
+{
+	ficlVmThrow(vm, FICL_VM_STATUS_QUIT);
+}
+
+static void
+ficlPrimitiveAbort(ficlVm *vm)
+{
+	ficlVmThrow(vm, FICL_VM_STATUS_ABORT);
+}
+
+/*
+ * a c c e p t
+ * accept	CORE ( c-addr +n1 -- +n2 )
+ * Receive a string of at most +n1 characters. An ambiguous condition
+ * exists if +n1 is zero or greater than 32,767. Display graphic characters
+ * as they are received. A program that depends on the presence or absence
+ * of non-graphic characters in the string has an environmental dependency.
+ * The editing functions, if any, that the system performs in order to
+ * construct the string are implementation-defined.
+ *
+ * (Although the standard text doesn't say so, I assume that the intent
+ * of 'accept' is to store the string at the address specified on
+ * the stack.)
+ *
+ * NOTE: getchar() is used there as its present both in loader and
+ *	userland; however, the more correct solution would be to set
+ *	terminal to raw mode for userland.
+ */
+static void
+ficlPrimitiveAccept(ficlVm *vm)
+{
+	ficlUnsigned size;
+	char *address;
+	int c;
+	ficlUnsigned length = 0;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 1);
+
+	size = ficlStackPopInteger(vm->dataStack);
+	address = ficlStackPopPointer(vm->dataStack);
+
+	while (size != length) {
+		c = getchar();
+		if (c == '\n' || c == '\r')
+			break;
+		address[length++] = c;
+	}
+	ficlStackPushInteger(vm->dataStack, length);
+}
+
+/*
+ * a l i g n
+ * 6.1.0705 ALIGN	CORE ( -- )
+ * If the data-space pointer is not aligned, reserve enough space to
+ * align it.
+ */
+static void
+ficlPrimitiveAlign(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	FICL_IGNORE(vm);
+	ficlDictionaryAlign(dictionary);
+}
+
+/*
+ * a l i g n e d
+ */
+static void
+ficlPrimitiveAligned(ficlVm *vm)
+{
+	void *addr;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 1);
+
+	addr = ficlStackPopPointer(vm->dataStack);
+	ficlStackPushPointer(vm->dataStack, ficlAlignPointer(addr));
+}
+
+/*
+ * b e g i n   &   f r i e n d s
+ * Indefinite loop control structures
+ * A.6.1.0760 BEGIN
+ * Typical use:
+ *	: X ... BEGIN ... test UNTIL ;
+ * or
+ *	: X ... BEGIN ... test WHILE ... REPEAT ;
+ */
+static void
+ficlPrimitiveBeginCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	markBranch(dictionary, vm, destTag);
+}
+
+static void
+ficlPrimitiveUntilCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionBranch0ParenWithCheck);
+	resolveBackBranch(dictionary, vm, destTag);
+}
+
+static void
+ficlPrimitiveWhileCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 5);
+
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionBranch0ParenWithCheck);
+	markBranch(dictionary, vm, origTag);
+
+	/* equivalent to 2swap */
+	ficlStackRoll(vm->dataStack, 3);
+	ficlStackRoll(vm->dataStack, 3);
+
+	ficlDictionaryAppendUnsigned(dictionary, 1);
+}
+
+static void
+ficlPrimitiveRepeatCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionBranchParenWithCheck);
+	/* expect "begin" branch marker */
+	resolveBackBranch(dictionary, vm, destTag);
+	/* expect "while" branch marker */
+	resolveForwardBranch(dictionary, vm, origTag);
+}
+
+static void
+ficlPrimitiveAgainCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryAppendUnsigned(dictionary,
+	    ficlInstructionBranchParenWithCheck);
+	/* expect "begin" branch marker */
+	resolveBackBranch(dictionary, vm, destTag);
+}
+
+/*
+ * c h a r   &   f r i e n d s
+ * 6.1.0895 CHAR	CORE ( "<spaces>name" -- char )
+ * Skip leading space delimiters. Parse name delimited by a space.
+ * Put the value of its first character onto the stack.
+ *
+ * bracket-char		CORE
+ * Interpretation: Interpretation semantics for this word are undefined.
+ * Compilation: ( "<spaces>name" -- )
+ * Skip leading space delimiters. Parse name delimited by a space.
+ * Append the run-time semantics given below to the current definition.
+ * Run-time: ( -- char )
+ * Place char, the value of the first character of name, on the stack.
+ */
+static void
+ficlPrimitiveChar(ficlVm *vm)
+{
+	ficlString s;
+
+	FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+	s = ficlVmGetWord(vm);
+	ficlStackPushUnsigned(vm->dataStack, (ficlUnsigned)(s.text[0]));
+}
+
+static void
+ficlPrimitiveCharCoIm(ficlVm *vm)
+{
+	ficlPrimitiveChar(vm);
+	ficlPrimitiveLiteralIm(vm);
+}
+
+/*
+ * c h a r P l u s
+ * char-plus	CORE ( c-addr1 -- c-addr2 )
+ * Add the size in address units of a character to c-addr1, giving c-addr2.
+ */
+static void
+ficlPrimitiveCharPlus(ficlVm *vm)
+{
+	char *p;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 1);
+
+	p = ficlStackPopPointer(vm->dataStack);
+	ficlStackPushPointer(vm->dataStack, p + 1);
+}
+
+/*
+ * c h a r s
+ * chars	CORE ( n1 -- n2 )
+ * n2 is the size in address units of n1 characters.
+ * For most processors, this function can be a no-op. To guarantee
+ * portability, we'll multiply by sizeof (char).
+ */
+#if defined(_M_IX86)
+#pragma warning(disable: 4127)
+#endif
+static void
+ficlPrimitiveChars(ficlVm *vm)
+{
+	if (sizeof (char) > 1) {
+		ficlInteger i;
+
+		FICL_STACK_CHECK(vm->dataStack, 1, 1);
+
+		i = ficlStackPopInteger(vm->dataStack);
+		ficlStackPushInteger(vm->dataStack, i * sizeof (char));
+	}
+	/* otherwise no-op! */
+}
+#if defined(_M_IX86)
+#pragma warning(default: 4127)
+#endif
+
+/*
+ * c o u n t
+ * COUNT	CORE ( c-addr1 -- c-addr2 u )
+ * Return the character string specification for the counted string stored
+ * at c-addr1. c-addr2 is the address of the first character after c-addr1.
+ * u is the contents of the character at c-addr1, which is the length in
+ * characters of the string at c-addr2.
+ */
+static void
+ficlPrimitiveCount(ficlVm *vm)
+{
+	ficlCountedString *counted;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 2);
+
+	counted = ficlStackPopPointer(vm->dataStack);
+	ficlStackPushPointer(vm->dataStack, counted->text);
+	ficlStackPushUnsigned(vm->dataStack, counted->length);
+}
+
+/*
+ * e n v i r o n m e n t ?
+ * environment-query CORE ( c-addr u -- FICL_FALSE | i*x FICL_TRUE )
+ * c-addr is the address of a character string and u is the string's
+ * character count. u may have a value in the range from zero to an
+ * implementation-defined maximum which shall not be less than 31. The
+ * character string should contain a keyword from 3.2.6 Environmental
+ * queries or the optional word sets to be checked for correspondence
+ * with an attribute of the present environment. If the system treats the
+ * attribute as unknown, the returned flag is FICL_FALSE; otherwise, the flag
+ * is FICL_TRUE and the i*x returned is of the type specified in the table for
+ * the attribute queried.
+ */
+static void
+ficlPrimitiveEnvironmentQ(ficlVm *vm)
+{
+	ficlDictionary *environment;
+	ficlWord *word;
+	ficlString name;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 1);
+
+	environment = vm->callback.system->environment;
+	name.length = ficlStackPopUnsigned(vm->dataStack);
+	name.text = ficlStackPopPointer(vm->dataStack);
+
+	word = ficlDictionaryLookup(environment, name);
+
+	if (word != NULL) {
+		ficlVmExecuteWord(vm, word);
+		ficlStackPushInteger(vm->dataStack, FICL_TRUE);
+	} else {
+		ficlStackPushInteger(vm->dataStack, FICL_FALSE);
+	}
+}
+
+/*
+ * e v a l u a t e
+ * EVALUATE CORE ( i*x c-addr u -- j*x )
+ * Save the current input source specification. Store minus-one (-1) in
+ * SOURCE-ID if it is present. Make the string described by c-addr and u
+ * both the input source and input buffer, set >IN to zero, and
+ * FICL_VM_STATE_INTERPRET.
+ * When the parse area is empty, restore the prior input source
+ * specification. Other stack effects are due to the words EVALUATEd.
+ */
+static void
+ficlPrimitiveEvaluate(ficlVm *vm)
+{
+	ficlCell id;
+	int result;
+	ficlString string;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 0);
+
+	FICL_STRING_SET_LENGTH(string, ficlStackPopUnsigned(vm->dataStack));
+	FICL_STRING_SET_POINTER(string, ficlStackPopPointer(vm->dataStack));
+
+	id = vm->sourceId;
+	vm->sourceId.i = -1;
+	result = ficlVmExecuteString(vm, string);
+	vm->sourceId = id;
+	if (result != FICL_VM_STATUS_OUT_OF_TEXT)
+		ficlVmThrow(vm, result);
+}
+
+/*
+ * s t r i n g   q u o t e
+ * Interpreting: get string delimited by a quote from the input stream,
+ * copy to a scratch area, and put its count and address on the stack.
+ * Compiling: FICL_VM_STATE_COMPILE code to push the address and count
+ * of a string literal, FICL_VM_STATE_COMPILE the string from the input
+ * stream, and align the dictionary pointer.
+ */
+static void
+ficlPrimitiveStringQuoteIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	if (vm->state == FICL_VM_STATE_INTERPRET) {
+		ficlCountedString *counted;
+		counted = (ficlCountedString *)dictionary->here;
+		ficlVmGetString(vm, counted, '\"');
+		ficlStackPushPointer(vm->dataStack, counted->text);
+		ficlStackPushUnsigned(vm->dataStack, counted->length);
+	} else {	/* FICL_VM_STATE_COMPILE state */
+		ficlDictionaryAppendUnsigned(dictionary,
+		    ficlInstructionStringLiteralParen);
+		dictionary->here = FICL_POINTER_TO_CELL(
+		    ficlVmGetString(vm, (ficlCountedString *)dictionary->here,
+		    '\"'));
+		ficlDictionaryAlign(dictionary);
+	}
+}
+
+/*
+ * t y p e
+ * Pop count and char address from stack and print the designated string.
+ */
+static void
+ficlPrimitiveType(ficlVm *vm)
+{
+	ficlUnsigned length;
+	char *s;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 0);
+
+	length = ficlStackPopUnsigned(vm->dataStack);
+	s = ficlStackPopPointer(vm->dataStack);
+
+	if ((s == NULL) || (length == 0))
+		return;
+
+	/*
+	 * Since we don't have an output primitive for a counted string
+	 * (oops), make sure the string is null terminated. If not, copy
+	 * and terminate it.
+	 */
+	if (s[length] != 0) {
+		char *here = (char *)ficlVmGetDictionary(vm)->here;
+		if (s != here)
+			strncpy(here, s, length);
+
+		here[length] = '\0';
+		s = here;
+	}
+
+	ficlVmTextOut(vm, s);
+}
+
+/*
+ * w o r d
+ * word CORE ( char "<chars>ccc<char>" -- c-addr )
+ * Skip leading delimiters. Parse characters ccc delimited by char. An
+ * ambiguous condition exists if the length of the parsed string is greater
+ * than the implementation-defined length of a counted string.
+ *
+ * c-addr is the address of a transient region containing the parsed word
+ * as a counted string. If the parse area was empty or contained no
+ * characters other than the delimiter, the resulting string has a zero
+ * length. A space, not included in the length, follows the string. A
+ * program may replace characters within the string.
+ * NOTE! Ficl also NULL-terminates the dest string.
+ */
+static void
+ficlPrimitiveWord(ficlVm *vm)
+{
+	ficlCountedString *counted;
+	char delim;
+	ficlString name;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 1);
+
+	counted = (ficlCountedString *)vm->pad;
+	delim = (char)ficlStackPopInteger(vm->dataStack);
+	name = ficlVmParseStringEx(vm, delim, 1);
+
+	if (FICL_STRING_GET_LENGTH(name) > FICL_PAD_SIZE - 1)
+		FICL_STRING_SET_LENGTH(name, FICL_PAD_SIZE - 1);
+
+	counted->length = (ficlUnsigned8)FICL_STRING_GET_LENGTH(name);
+	strncpy(counted->text, FICL_STRING_GET_POINTER(name),
+	    FICL_STRING_GET_LENGTH(name));
+
+	/*
+	 * store an extra space at the end of the primitive...
+	 * why? dunno yet.  Guy Carver did it.
+	 */
+	counted->text[counted->length] = ' ';
+	counted->text[counted->length + 1] = 0;
+
+	ficlStackPushPointer(vm->dataStack, counted);
+}
+
+/*
+ * p a r s e - w o r d
+ * Ficl   PARSE-WORD  ( <spaces>name -- c-addr u )
+ * Skip leading spaces and parse name delimited by a space. c-addr is the
+ * address within the input buffer and u is the length of the selected
+ * string. If the parse area is empty, the resulting string has a zero length.
+ */
+static void ficlPrimitiveParseNoCopy(ficlVm *vm)
+{
+	ficlString s;
+
+	FICL_STACK_CHECK(vm->dataStack, 0, 2);
+
+	s = ficlVmGetWord0(vm);
+	ficlStackPushPointer(vm->dataStack, FICL_STRING_GET_POINTER(s));
+	ficlStackPushUnsigned(vm->dataStack, FICL_STRING_GET_LENGTH(s));
+}
+
+/*
+ * p a r s e
+ * CORE EXT  ( char "ccc<char>" -- c-addr u )
+ * Parse ccc delimited by the delimiter char.
+ * c-addr is the address (within the input buffer) and u is the length of
+ * the parsed string. If the parse area was empty, the resulting string has
+ * a zero length.
+ * NOTE! PARSE differs from WORD: it does not skip leading delimiters.
+ */
+static void
+ficlPrimitiveParse(ficlVm *vm)
+{
+	ficlString s;
+	char delim;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 2);
+
+	delim = (char)ficlStackPopInteger(vm->dataStack);
+
+	s = ficlVmParseStringEx(vm, delim, 0);
+	ficlStackPushPointer(vm->dataStack, FICL_STRING_GET_POINTER(s));
+	ficlStackPushUnsigned(vm->dataStack, FICL_STRING_GET_LENGTH(s));
+}
+
+/*
+ * 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
+do_find(ficlVm *vm, ficlString name, void *returnForFailure)
+{
+	ficlWord *word;
+
+	word = ficlDictionaryLookup(ficlVmGetDictionary(vm), name);
+	if (word) {
+		ficlStackPushPointer(vm->dataStack, word);
+		ficlStackPushInteger(vm->dataStack,
+		    (ficlWordIsImmediate(word) ? 1 : -1));
+	} else {
+		ficlStackPushPointer(vm->dataStack, returnForFailure);
+		ficlStackPushUnsigned(vm->dataStack, 0);
+	}
+}
+
+/*
+ * 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
+ficlPrimitiveCFind(ficlVm *vm)
+{
+	ficlCountedString *counted;
+	ficlString name;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 2);
+
+	counted = ficlStackPopPointer(vm->dataStack);
+	FICL_STRING_SET_FROM_COUNTED_STRING(name, *counted);
+	do_find(vm, name, counted);
+}
+
+/*
+ * 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
+ficlPrimitiveSFind(ficlVm *vm)
+{
+	ficlString name;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 2);
+
+	name.length = ficlStackPopInteger(vm->dataStack);
+	name.text = ficlStackPopPointer(vm->dataStack);
+
+	do_find(vm, name, NULL);
+}
+
+/*
+ * r e c u r s e
+ */
+static void
+ficlPrimitiveRecurseCoIm(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlCell c;
+
+	FICL_IGNORE(vm);
+	c.p = dictionary->smudge;
+	ficlDictionaryAppendCell(dictionary, c);
+}
+
+/*
+ * s o u r c e
+ * CORE ( -- c-addr u )
+ * c-addr is the address of, and u is the number of characters in, the
+ * input buffer.
+ */
+static void
+ficlPrimitiveSource(ficlVm *vm)
+{
+	FICL_STACK_CHECK(vm->dataStack, 0, 2);
+
+	ficlStackPushPointer(vm->dataStack, vm->tib.text);
+	ficlStackPushInteger(vm->dataStack, ficlVmGetInBufLen(vm));
+}
+
+/*
+ * v e r s i o n
+ * non-standard...
+ */
+static void
+ficlPrimitiveVersion(ficlVm *vm)
+{
+	ficlVmTextOut(vm, "Ficl version " FICL_VERSION "\n");
+}
+
+/*
+ * t o I n
+ * to-in CORE
+ */
+static void
+ficlPrimitiveToIn(ficlVm *vm)
+{
+	FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+	ficlStackPushPointer(vm->dataStack, &vm->tib.index);
+}
+
+/*
+ * c o l o n N o N a m e
+ * CORE EXT ( C:  -- colon-sys )  ( S:  -- xt )
+ * Create an unnamed colon definition and push its address.
+ * Change state to FICL_VM_STATE_COMPILE.
+ */
+static void
+ficlPrimitiveColonNoName(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlWord *word;
+	ficlString name;
+
+	FICL_STRING_SET_LENGTH(name, 0);
+	FICL_STRING_SET_POINTER(name, NULL);
+
+	vm->state = FICL_VM_STATE_COMPILE;
+	word = ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)ficlInstructionColonParen,
+	    FICL_WORD_DEFAULT | FICL_WORD_SMUDGED);
+
+	ficlStackPushPointer(vm->dataStack, word);
+	markControlTag(vm, colonTag);
+}
+
+/*
+ * u s e r   V a r i a b l e
+ * user  ( u -- )  "<spaces>name"
+ * Get a name from the input stream and create a user variable
+ * with the name and the index supplied. The run-time effect
+ * of a user variable is to push the address of the indexed ficlCell
+ * in the running vm's user array.
+ *
+ * User variables are vm local cells. Each vm has an array of
+ * FICL_USER_CELLS of them when FICL_WANT_USER is nonzero.
+ * Ficl's user facility is implemented with two primitives,
+ * "user" and "(user)", a variable ("nUser") (in softcore.c) that
+ * holds the index of the next free user ficlCell, and a redefinition
+ * (also in softcore) of "user" that defines a user word and increments
+ * nUser.
+ */
+#if FICL_WANT_USER
+static void
+ficlPrimitiveUser(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlString name = ficlVmGetWord(vm);
+	ficlCell c;
+
+	c = ficlStackPop(vm->dataStack);
+	if (c.i >= FICL_USER_CELLS) {
+		ficlVmThrowError(vm, "Error - out of user space");
+	}
+
+	ficlDictionaryAppendWord(dictionary, name,
+	    (ficlPrimitive)ficlInstructionUserParen, FICL_WORD_DEFAULT);
+	ficlDictionaryAppendCell(dictionary, c);
+}
+#endif
+
+#if FICL_WANT_LOCALS
+/*
+ * Each local is recorded in a private locals dictionary as a
+ * word that does doLocalIm at runtime. DoLocalIm compiles code
+ * into the client definition to fetch the value of the
+ * corresponding local variable from the return stack.
+ * The private dictionary gets initialized at the end of each block
+ * that uses locals (in ; and does> for example).
+ */
+void
+ficlLocalParenIm(ficlVm *vm, int isDouble, int isFloat)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlInteger nLocal = vm->runningWord->param[0].i;
+
+#if !FICL_WANT_FLOAT
+	FICL_VM_ASSERT(vm, !isFloat);
+	/* get rid of unused parameter warning */
+	isFloat = 0;
+#endif /* FICL_WANT_FLOAT */
+
+	if (vm->state == FICL_VM_STATE_INTERPRET) {
+		ficlStack *stack;
+#if FICL_WANT_FLOAT
+		if (isFloat)
+			stack = vm->floatStack;
+		else
+#endif /* FICL_WANT_FLOAT */
+			stack = vm->dataStack;
+
+		ficlStackPush(stack, vm->returnStack->frame[nLocal]);
+		if (isDouble)
+			ficlStackPush(stack, vm->returnStack->frame[nLocal+1]);
+	} else {
+		ficlInstruction instruction;
+		ficlInteger appendLocalOffset;
+#if FICL_WANT_FLOAT
+		if (isFloat) {
+			instruction =
+			    (isDouble) ? ficlInstructionGetF2LocalParen :
+			    ficlInstructionGetFLocalParen;
+			appendLocalOffset = FICL_TRUE;
+		} else
+#endif /* FICL_WANT_FLOAT */
+		if (nLocal == 0) {
+			instruction = (isDouble) ? ficlInstructionGet2Local0 :
+			    ficlInstructionGetLocal0;
+			appendLocalOffset = FICL_FALSE;
+		} else if ((nLocal == 1) && !isDouble) {
+			instruction = ficlInstructionGetLocal1;
+			appendLocalOffset = FICL_FALSE;
+		} else {
+			instruction =
+			    (isDouble) ? ficlInstructionGet2LocalParen :
+			    ficlInstructionGetLocalParen;
+			appendLocalOffset = FICL_TRUE;
+		}
+
+		ficlDictionaryAppendUnsigned(dictionary, instruction);
+		if (appendLocalOffset)
+			ficlDictionaryAppendUnsigned(dictionary, nLocal);
+	}
+}
+
+static void
+ficlPrimitiveDoLocalIm(ficlVm *vm)
+{
+	ficlLocalParenIm(vm, 0, 0);
+}
+
+static void
+ficlPrimitiveDo2LocalIm(ficlVm *vm)
+{
+	ficlLocalParenIm(vm, 1, 0);
+}
+
+#if FICL_WANT_FLOAT
+static void
+ficlPrimitiveDoFLocalIm(ficlVm *vm)
+{
+	ficlLocalParenIm(vm, 0, 1);
+}
+
+static void
+ficlPrimitiveDoF2LocalIm(ficlVm *vm)
+{
+	ficlLocalParenIm(vm, 1, 1);
+}
+#endif /* FICL_WANT_FLOAT */
+
+/*
+ * l o c a l P a r e n
+ * paren-local-paren LOCAL
+ * Interpretation: Interpretation semantics for this word are undefined.
+ * Execution: ( c-addr u -- )
+ * When executed during compilation, (LOCAL) passes a message to the
+ * system that has one of two meanings. If u is non-zero,
+ * the message identifies a new local whose definition name is given by
+ * the string of characters identified by c-addr u. If u is zero,
+ * the message is last local and c-addr has no significance.
+ *
+ * The result of executing (LOCAL) during compilation of a definition is
+ * to create a set of named local identifiers, each of which is
+ * a definition name, that only have execution semantics within the scope
+ * of that definition's source.
+ *
+ * local Execution: ( -- x )
+ *
+ * Push the local's value, x, onto the stack. The local's value is
+ * initialized as described in 13.3.3 Processing locals and may be
+ * changed by preceding the local's name with TO. An ambiguous condition
+ * exists when local is executed while in interpretation state.
+ */
+void
+ficlLocalParen(ficlVm *vm, int isDouble, int isFloat)
+{
+	ficlDictionary *dictionary;
+	ficlString name;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 0);
+
+	dictionary = ficlVmGetDictionary(vm);
+	FICL_STRING_SET_LENGTH(name, ficlStackPopUnsigned(vm->dataStack));
+	FICL_STRING_SET_POINTER(name,
+	    (char *)ficlStackPopPointer(vm->dataStack));
+
+	if (FICL_STRING_GET_LENGTH(name) > 0) {
+		/*
+		 * add a local to the **locals** dictionary and
+		 * update localsCount
+		 */
+		ficlPrimitive code;
+		ficlInstruction instruction;
+		ficlDictionary *locals;
+
+		locals = ficlSystemGetLocals(vm->callback.system);
+		if (vm->callback.system->localsCount >= FICL_MAX_LOCALS) {
+			ficlVmThrowError(vm, "Error: out of local space");
+		}
+
+#if !FICL_WANT_FLOAT
+		FICL_VM_ASSERT(vm, !isFloat);
+		/* get rid of unused parameter warning */
+		isFloat = 0;
+#else /* FICL_WANT_FLOAT */
+		if (isFloat) {
+			if (isDouble) {
+				code = ficlPrimitiveDoF2LocalIm;
+				instruction = ficlInstructionToF2LocalParen;
+			} else {
+				code = ficlPrimitiveDoFLocalIm;
+				instruction = ficlInstructionToFLocalParen;
+			}
+		} else
+#endif /* FICL_WANT_FLOAT */
+		if (isDouble) {
+			code = ficlPrimitiveDo2LocalIm;
+			instruction = ficlInstructionTo2LocalParen;
+		} else {
+			code = ficlPrimitiveDoLocalIm;
+			instruction = ficlInstructionToLocalParen;
+		}
+
+		ficlDictionaryAppendWord(locals, name, code,
+		    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+		ficlDictionaryAppendUnsigned(locals,
+		    vm->callback.system->localsCount);
+
+		if (vm->callback.system->localsCount == 0) {
+			/*
+			 * FICL_VM_STATE_COMPILE code to create a local
+			 * stack frame
+			 */
+			ficlDictionaryAppendUnsigned(dictionary,
+			    ficlInstructionLinkParen);
+
+			/* save location in dictionary for #locals */
+			vm->callback.system->localsFixup = dictionary->here;
+			ficlDictionaryAppendUnsigned(dictionary,
+			    vm->callback.system->localsCount);
+		}
+
+		ficlDictionaryAppendUnsigned(dictionary, instruction);
+		ficlDictionaryAppendUnsigned(dictionary,
+		    vm->callback.system->localsCount);
+
+		vm->callback.system->localsCount += (isDouble) ? 2 : 1;
+	} else if (vm->callback.system->localsCount > 0) {
+		/* write localsCount to (link) param area in dictionary */
+		*(ficlInteger *)(vm->callback.system->localsFixup) =
+		    vm->callback.system->localsCount;
+	}
+}
+
+static void
+ficlPrimitiveLocalParen(ficlVm *vm)
+{
+	ficlLocalParen(vm, 0, 0);
+}
+
+static void
+ficlPrimitive2LocalParen(ficlVm *vm)
+{
+	ficlLocalParen(vm, 1, 0);
+}
+#endif /* FICL_WANT_LOCALS */
+
+/*
+ * t o V a l u e
+ * CORE EXT
+ * Interpretation: ( x "<spaces>name" -- )
+ * Skip leading spaces and parse name delimited by a space. Store x in
+ * name. An ambiguous condition exists if name was not defined by VALUE.
+ * NOTE: In Ficl, VALUE is an alias of CONSTANT
+ */
+static void
+ficlPrimitiveToValue(ficlVm *vm)
+{
+	ficlString name = ficlVmGetWord(vm);
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlWord *word;
+	ficlInstruction instruction = 0;
+	ficlStack *stack;
+	ficlInteger isDouble;
+#if FICL_WANT_LOCALS
+	ficlInteger nLocal;
+	ficlInteger appendLocalOffset;
+	ficlInteger isFloat;
+#endif /* FICL_WANT_LOCALS */
+
+#if FICL_WANT_LOCALS
+	if ((vm->callback.system->localsCount > 0) &&
+	    (vm->state == FICL_VM_STATE_COMPILE)) {
+		ficlDictionary *locals;
+
+		locals = ficlSystemGetLocals(vm->callback.system);
+		word = ficlDictionaryLookup(locals, name);
+		if (!word)
+			goto TO_GLOBAL;
+
+		if (word->code == ficlPrimitiveDoLocalIm) {
+			instruction = ficlInstructionToLocalParen;
+			isDouble = isFloat = FICL_FALSE;
+		} else if (word->code == ficlPrimitiveDo2LocalIm) {
+			instruction = ficlInstructionTo2LocalParen;
+			isDouble = FICL_TRUE;
+			isFloat = FICL_FALSE;
+		}
+#if FICL_WANT_FLOAT
+		else if (word->code == ficlPrimitiveDoFLocalIm) {
+			instruction = ficlInstructionToFLocalParen;
+			isDouble = FICL_FALSE;
+			isFloat = FICL_TRUE;
+		} else if (word->code == ficlPrimitiveDoF2LocalIm) {
+			instruction = ficlInstructionToF2LocalParen;
+			isDouble = isFloat = FICL_TRUE;
+		}
+#endif /* FICL_WANT_FLOAT */
+		else {
+			ficlVmThrowError(vm,
+			    "to %.*s : local is of unknown type",
+			    FICL_STRING_GET_LENGTH(name),
+			    FICL_STRING_GET_POINTER(name));
+			return;
+		}
+
+		nLocal = word->param[0].i;
+		appendLocalOffset = FICL_TRUE;
+
+#if FICL_WANT_FLOAT
+		if (!isFloat) {
+#endif /* FICL_WANT_FLOAT */
+			if (nLocal == 0) {
+				instruction =
+				    (isDouble) ? ficlInstructionTo2Local0 :
+				    ficlInstructionToLocal0;
+				appendLocalOffset = FICL_FALSE;
+			} else if ((nLocal == 1) && !isDouble) {
+				instruction = ficlInstructionToLocal1;
+				appendLocalOffset = FICL_FALSE;
+			}
+#if FICL_WANT_FLOAT
+		}
+#endif /* FICL_WANT_FLOAT */
+
+		ficlDictionaryAppendUnsigned(dictionary, instruction);
+		if (appendLocalOffset)
+			ficlDictionaryAppendUnsigned(dictionary, nLocal);
+		return;
+	}
+#endif
+
+#if FICL_WANT_LOCALS
+TO_GLOBAL:
+#endif /* FICL_WANT_LOCALS */
+	word = ficlDictionaryLookup(dictionary, name);
+	if (!word)
+		ficlVmThrowError(vm, "%.*s not found",
+		    FICL_STRING_GET_LENGTH(name),
+		    FICL_STRING_GET_POINTER(name));
+
+	switch ((ficlInstruction)word->code) {
+	case ficlInstructionConstantParen:
+		instruction = ficlInstructionStore;
+		stack = vm->dataStack;
+		isDouble = FICL_FALSE;
+	break;
+	case ficlInstruction2ConstantParen:
+		instruction = ficlInstruction2Store;
+		stack = vm->dataStack;
+		isDouble = FICL_TRUE;
+	break;
+#if FICL_WANT_FLOAT
+	case ficlInstructionFConstantParen:
+		instruction = ficlInstructionFStore;
+		stack = vm->floatStack;
+		isDouble = FICL_FALSE;
+	break;
+	case ficlInstructionF2ConstantParen:
+		instruction = ficlInstructionF2Store;
+		stack = vm->floatStack;
+		isDouble = FICL_TRUE;
+	break;
+#endif /* FICL_WANT_FLOAT */
+	default:
+		ficlVmThrowError(vm,
+		    "to %.*s : value/constant is of unknown type",
+		    FICL_STRING_GET_LENGTH(name),
+		    FICL_STRING_GET_POINTER(name));
+	return;
+	}
+
+	if (vm->state == FICL_VM_STATE_INTERPRET) {
+		word->param[0] = ficlStackPop(stack);
+		if (isDouble)
+			word->param[1] = ficlStackPop(stack);
+	} else {
+		/* FICL_VM_STATE_COMPILE code to store to word's param */
+		ficlStackPushPointer(vm->dataStack, &word->param[0]);
+		ficlPrimitiveLiteralIm(vm);
+		ficlDictionaryAppendUnsigned(dictionary, instruction);
+	}
+}
+
+/*
+ * f m S l a s h M o d
+ * f-m-slash-mod CORE ( d1 n1 -- n2 n3 )
+ * Divide d1 by n1, giving the floored quotient n3 and the remainder n2.
+ * Input and output stack arguments are signed. An ambiguous condition
+ * exists if n1 is zero or if the quotient lies outside the range of a
+ * single-ficlCell signed integer.
+ */
+static void
+ficlPrimitiveFMSlashMod(ficlVm *vm)
+{
+	ficl2Integer d1;
+	ficlInteger n1;
+	ficl2IntegerQR qr;
+
+	FICL_STACK_CHECK(vm->dataStack, 3, 2);
+
+	n1 = ficlStackPopInteger(vm->dataStack);
+	d1 = ficlStackPop2Integer(vm->dataStack);
+	qr = ficl2IntegerDivideFloored(d1, n1);
+	ficlStackPushInteger(vm->dataStack, qr.remainder);
+	ficlStackPushInteger(vm->dataStack,
+	    FICL_2UNSIGNED_GET_LOW(qr.quotient));
+}
+
+/*
+ * s m S l a s h R e m
+ * s-m-slash-remainder CORE ( d1 n1 -- n2 n3 )
+ * Divide d1 by n1, giving the symmetric quotient n3 and the remainder n2.
+ * Input and output stack arguments are signed. An ambiguous condition
+ * exists if n1 is zero or if the quotient lies outside the range of a
+ * single-ficlCell signed integer.
+ */
+static void
+ficlPrimitiveSMSlashRem(ficlVm *vm)
+{
+	ficl2Integer d1;
+	ficlInteger n1;
+	ficl2IntegerQR qr;
+
+	FICL_STACK_CHECK(vm->dataStack, 3, 2);
+
+	n1 = ficlStackPopInteger(vm->dataStack);
+	d1 = ficlStackPop2Integer(vm->dataStack);
+	qr = ficl2IntegerDivideSymmetric(d1, n1);
+	ficlStackPushInteger(vm->dataStack, qr.remainder);
+	ficlStackPushInteger(vm->dataStack,
+	    FICL_2UNSIGNED_GET_LOW(qr.quotient));
+}
+
+static void
+ficlPrimitiveMod(ficlVm *vm)
+{
+	ficl2Integer d1;
+	ficlInteger n1;
+	ficlInteger i;
+	ficl2IntegerQR qr;
+	FICL_STACK_CHECK(vm->dataStack, 2, 1);
+
+	n1 = ficlStackPopInteger(vm->dataStack);
+	i = ficlStackPopInteger(vm->dataStack);
+	FICL_INTEGER_TO_2INTEGER(i, d1);
+	qr = ficl2IntegerDivideSymmetric(d1, n1);
+	ficlStackPushInteger(vm->dataStack, qr.remainder);
+}
+
+/*
+ * u m S l a s h M o d
+ * u-m-slash-mod CORE ( ud u1 -- u2 u3 )
+ * Divide ud by u1, giving the quotient u3 and the remainder u2.
+ * All values and arithmetic are unsigned. An ambiguous condition
+ * exists if u1 is zero or if the quotient lies outside the range of a
+ * single-ficlCell unsigned integer.
+ */
+static void
+ficlPrimitiveUMSlashMod(ficlVm *vm)
+{
+	ficl2Unsigned ud;
+	ficlUnsigned u1;
+	ficl2UnsignedQR uqr;
+
+	u1    = ficlStackPopUnsigned(vm->dataStack);
+	ud    = ficlStackPop2Unsigned(vm->dataStack);
+	uqr   = ficl2UnsignedDivide(ud, u1);
+	ficlStackPushUnsigned(vm->dataStack, uqr.remainder);
+	ficlStackPushUnsigned(vm->dataStack,
+	    FICL_2UNSIGNED_GET_LOW(uqr.quotient));
+}
+
+/*
+ * m S t a r
+ * m-star CORE ( n1 n2 -- d )
+ * d is the signed product of n1 times n2.
+ */
+static void
+ficlPrimitiveMStar(ficlVm *vm)
+{
+	ficlInteger n2;
+	ficlInteger n1;
+	ficl2Integer d;
+	FICL_STACK_CHECK(vm->dataStack, 2, 2);
+
+	n2 = ficlStackPopInteger(vm->dataStack);
+	n1 = ficlStackPopInteger(vm->dataStack);
+
+	d = ficl2IntegerMultiply(n1, n2);
+	ficlStackPush2Integer(vm->dataStack, d);
+}
+
+static void
+ficlPrimitiveUMStar(ficlVm *vm)
+{
+	ficlUnsigned u2;
+	ficlUnsigned u1;
+	ficl2Unsigned ud;
+	FICL_STACK_CHECK(vm->dataStack, 2, 2);
+
+	u2 = ficlStackPopUnsigned(vm->dataStack);
+	u1 = ficlStackPopUnsigned(vm->dataStack);
+
+	ud = ficl2UnsignedMultiply(u1, u2);
+	ficlStackPush2Unsigned(vm->dataStack, ud);
+}
+
+/*
+ * 2 r o t
+ * DOUBLE   ( d1 d2 d3 -- d2 d3 d1 )
+ */
+static void
+ficlPrimitive2Rot(ficlVm *vm)
+{
+	ficl2Integer d1, d2, d3;
+	FICL_STACK_CHECK(vm->dataStack, 6, 6);
+
+	d3 = ficlStackPop2Integer(vm->dataStack);
+	d2 = ficlStackPop2Integer(vm->dataStack);
+	d1 = ficlStackPop2Integer(vm->dataStack);
+	ficlStackPush2Integer(vm->dataStack, d2);
+	ficlStackPush2Integer(vm->dataStack, d3);
+	ficlStackPush2Integer(vm->dataStack, d1);
+}
+
+/*
+ * 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
+ficlPrimitivePad(ficlVm *vm)
+{
+	ficlStackPushPointer(vm->dataStack, vm->pad);
+}
+
+/*
+ * s o u r c e - i d
+ * CORE EXT, FILE   ( -- 0 | -1 | fileid )
+ *    Identifies the input source as follows:
+ *
+ * SOURCE-ID       Input source
+ * ---------       ------------
+ * fileid          Text file fileid
+ * -1              String (via EVALUATE)
+ * 0               User input device
+ */
+static void
+ficlPrimitiveSourceID(ficlVm *vm)
+{
+	ficlStackPushInteger(vm->dataStack, vm->sourceId.i);
+}
+
+/*
+ * r e f i l l
+ * CORE EXT   ( -- flag )
+ * Attempt to fill the input buffer from the input source, returning
+ * a FICL_TRUE flag if successful.
+ * When the input source is the user input device, attempt to receive input
+ * into the terminal input buffer. If successful, make the result the input
+ * buffer, set >IN to zero, and return FICL_TRUE. Receipt of a line containing
+ * no characters is considered successful. If there is no input available from
+ * the current input source, return FICL_FALSE.
+ * When the input source is a string from EVALUATE, return FICL_FALSE and
+ * perform no other action.
+ */
+static void
+ficlPrimitiveRefill(ficlVm *vm)
+{
+	ficlInteger ret = (vm->sourceId.i == -1) ? FICL_FALSE : FICL_TRUE;
+	if (ret && (vm->restart == 0))
+		ficlVmThrow(vm, FICL_VM_STATUS_RESTART);
+
+	ficlStackPushInteger(vm->dataStack, ret);
+}
+
+/*
+ * freebsd exception handling words
+ * Catch, from ANS Forth standard. Installs a safety net, then EXECUTE
+ * the word in ToS. If an exception happens, restore the state to what
+ * it was before, and pushes the exception value on the stack. If not,
+ * push zero.
+ *
+ * Notice that Catch implements an inner interpreter. This is ugly,
+ * but given how Ficl works, it cannot be helped. The problem is that
+ * colon definitions will be executed *after* the function returns,
+ * while "code" definitions will be executed immediately. I considered
+ * other solutions to this problem, but all of them shared the same
+ * basic problem (with added disadvantages): if Ficl ever changes it's
+ * inner thread modus operandi, one would have to fix this word.
+ *
+ * More comments can be found throughout catch's code.
+ *
+ * Daniel C. Sobral Jan 09/1999
+ * sadler may 2000 -- revised to follow ficl.c:ficlExecXT.
+ */
+static void
+ficlPrimitiveCatch(ficlVm *vm)
+{
+	int except;
+	jmp_buf vmState;
+	ficlVm vmCopy;
+	ficlStack dataStackCopy;
+	ficlStack returnStackCopy;
+	ficlWord *word;
+
+	FICL_VM_ASSERT(vm, vm);
+	FICL_VM_ASSERT(vm, vm->callback.system->exitInnerWord);
+
+	/*
+	 * Get xt.
+	 * We need this *before* we save the stack pointer, or
+	 * we'll have to pop one element out of the stack after
+	 * an exception. I prefer to get done with it up front. :-)
+	 */
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	word = ficlStackPopPointer(vm->dataStack);
+
+	/*
+	 * Save vm's state -- a catch will not back out environmental
+	 * changes.
+	 *
+	 * We are *not* saving dictionary state, since it is
+	 * global instead of per vm, and we are not saving
+	 * stack contents, since we are not required to (and,
+	 * thus, it would be useless). We save vm, and vm
+	 * "stacks" (a structure containing general information
+	 * about it, including the current stack pointer).
+	 */
+	memcpy((void*)&vmCopy, (void*)vm, sizeof (ficlVm));
+	memcpy((void*)&dataStackCopy, (void*)vm->dataStack, sizeof (ficlStack));
+	memcpy((void*)&returnStackCopy, (void*)vm->returnStack,
+	    sizeof (ficlStack));
+
+	/*
+	 * Give vm a jmp_buf
+	 */
+	vm->exceptionHandler = &vmState;
+
+	/*
+	 * Safety net
+	 */
+	except = setjmp(vmState);
+
+	switch (except) {
+	/*
+	 * Setup condition - push poison pill so that the VM throws
+	 * VM_INNEREXIT if the XT terminates normally, then execute
+	 * the XT
+	 */
+	case 0:
+		/* Open mouth, insert emetic */
+		ficlVmPushIP(vm, &(vm->callback.system->exitInnerWord));
+		ficlVmExecuteWord(vm, word);
+		ficlVmInnerLoop(vm, 0);
+	break;
+
+	/*
+	 * Normal exit from XT - lose the poison pill,
+	 * restore old setjmp vector and push a zero.
+	 */
+	case FICL_VM_STATUS_INNER_EXIT:
+		ficlVmPopIP(vm);	/* Gack - hurl poison pill */
+					/* Restore just the setjmp vector */
+		vm->exceptionHandler = vmCopy.exceptionHandler;
+					/* Push 0 -- everything is ok */
+		ficlStackPushInteger(vm->dataStack, 0);
+	break;
+
+	/*
+	 * Some other exception got thrown - restore pre-existing VM state
+	 * and push the exception code
+	 */
+	default:
+		/* Restore vm's state */
+		memcpy((void*)vm, (void*)&vmCopy, sizeof (ficlVm));
+		memcpy((void*)vm->dataStack, (void*)&dataStackCopy,
+		    sizeof (ficlStack));
+		memcpy((void*)vm->returnStack, (void*)&returnStackCopy,
+		    sizeof (ficlStack));
+
+		ficlStackPushInteger(vm->dataStack, except); /* Push error */
+	break;
+	}
+}
+
+/*
+ * t h r o w
+ * EXCEPTION
+ * Throw --  From ANS Forth standard.
+ *
+ * Throw takes the ToS and, if that's different from zero,
+ * returns to the last executed catch context. Further throws will
+ * unstack previously executed "catches", in LIFO mode.
+ *
+ * Daniel C. Sobral Jan 09/1999
+ */
+static void
+ficlPrimitiveThrow(ficlVm *vm)
+{
+	int except;
+
+	except = ficlStackPopInteger(vm->dataStack);
+
+	if (except)
+		ficlVmThrow(vm, except);
+}
+
+/*
+ * a l l o c a t e
+ * MEMORY
+ */
+static void
+ficlPrimitiveAllocate(ficlVm *vm)
+{
+	size_t size;
+	void *p;
+
+	size = ficlStackPopInteger(vm->dataStack);
+	p = ficlMalloc(size);
+	ficlStackPushPointer(vm->dataStack, p);
+	if (p != NULL)
+		ficlStackPushInteger(vm->dataStack, 0);
+	else
+		ficlStackPushInteger(vm->dataStack, 1);
+}
+
+/*
+ * f r e e
+ * MEMORY
+ */
+static void
+ficlPrimitiveFree(ficlVm *vm)
+{
+	void *p;
+
+	p = ficlStackPopPointer(vm->dataStack);
+	ficlFree(p);
+	ficlStackPushInteger(vm->dataStack, 0);
+}
+
+/*
+ * r e s i z e
+ * MEMORY
+ */
+static void
+ficlPrimitiveResize(ficlVm *vm)
+{
+	size_t size;
+	void *new, *old;
+
+	size = ficlStackPopInteger(vm->dataStack);
+	old = ficlStackPopPointer(vm->dataStack);
+	new = ficlRealloc(old, size);
+
+	if (new) {
+		ficlStackPushPointer(vm->dataStack, new);
+		ficlStackPushInteger(vm->dataStack, 0);
+	} else {
+		ficlStackPushPointer(vm->dataStack, old);
+		ficlStackPushInteger(vm->dataStack, 1);
+	}
+}
+
+/*
+ * e x i t - i n n e r
+ * Signals execXT that an inner loop has completed
+ */
+static void
+ficlPrimitiveExitInner(ficlVm *vm)
+{
+	ficlVmThrow(vm, FICL_VM_STATUS_INNER_EXIT);
+}
+
+#if 0
+static void
+ficlPrimitiveName(ficlVm *vm)
+{
+	FICL_IGNORE(vm);
+}
+#endif
+
+/*
+ * f i c l C o m p i l e C o r e
+ * Builds the primitive wordset and the environment-query namespace.
+ */
+void
+ficlSystemCompileCore(ficlSystem *system)
+{
+	ficlWord *interpret;
+	ficlDictionary *dictionary = ficlSystemGetDictionary(system);
+	ficlDictionary *environment = ficlSystemGetEnvironment(system);
+
+	FICL_SYSTEM_ASSERT(system, dictionary);
+	FICL_SYSTEM_ASSERT(system, environment);
+
+#define	FICL_TOKEN(token, description)
+#define	FICL_INSTRUCTION_TOKEN(token, description, flags)	\
+	ficlDictionarySetInstruction(dictionary, description, token, flags);
+#include "ficltokens.h"
+#undef FICL_TOKEN
+#undef FICL_INSTRUCTION_TOKEN
+
+	/*
+	 * The Core word set
+	 * see softcore.c for definitions of: abs bl space spaces abort"
+	 */
+	ficlDictionarySetPrimitive(dictionary, "#", ficlPrimitiveNumberSign,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "#>",
+	    ficlPrimitiveNumberSignGreater, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "#s", ficlPrimitiveNumberSignS,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "\'", ficlPrimitiveTick,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "(", ficlPrimitiveParenthesis,
+	    FICL_WORD_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "+loop",
+	    ficlPrimitivePlusLoopCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, ".", ficlPrimitiveDot,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, ".\"",
+	    ficlPrimitiveDotQuoteCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, ":", ficlPrimitiveColon,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, ";", ficlPrimitiveSemicolonCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "<#",
+	    ficlPrimitiveLessNumberSign, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, ">body", ficlPrimitiveToBody,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, ">in", ficlPrimitiveToIn,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, ">number", ficlPrimitiveToNumber,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "abort", ficlPrimitiveAbort,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "accept", ficlPrimitiveAccept,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "align", ficlPrimitiveAlign,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "aligned", ficlPrimitiveAligned,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "allot", ficlPrimitiveAllot,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "base", ficlPrimitiveBase,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "begin", ficlPrimitiveBeginCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "case", ficlPrimitiveCaseCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "char", ficlPrimitiveChar,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "char+", ficlPrimitiveCharPlus,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "chars", ficlPrimitiveChars,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "constant",
+	    ficlPrimitiveConstant, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "count", ficlPrimitiveCount,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "cr", ficlPrimitiveCR,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "create", ficlPrimitiveCreate,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "decimal", ficlPrimitiveDecimal,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "depth", ficlPrimitiveDepth,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "do", ficlPrimitiveDoCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "does>", ficlPrimitiveDoesCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "else", ficlPrimitiveElseCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "emit", ficlPrimitiveEmit,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "endcase",
+	    ficlPrimitiveEndcaseCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "endof", ficlPrimitiveEndofCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "environment?",
+	    ficlPrimitiveEnvironmentQ, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "evaluate",
+	    ficlPrimitiveEvaluate, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "execute", ficlPrimitiveExecute,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "exit", ficlPrimitiveExitCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "fallthrough",
+	    ficlPrimitiveFallthroughCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "find", ficlPrimitiveCFind,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "fm/mod",
+	    ficlPrimitiveFMSlashMod, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "here", ficlPrimitiveHere,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "hold", ficlPrimitiveHold,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "if", ficlPrimitiveIfCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "immediate",
+	    ficlPrimitiveImmediate, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "literal",
+	    ficlPrimitiveLiteralIm, FICL_WORD_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "loop", ficlPrimitiveLoopCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "m*", ficlPrimitiveMStar,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "mod", ficlPrimitiveMod,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "of", ficlPrimitiveOfCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "postpone",
+	    ficlPrimitivePostponeCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "quit", ficlPrimitiveQuit,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "recurse",
+	    ficlPrimitiveRecurseCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "repeat",
+	    ficlPrimitiveRepeatCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "s\"",
+	    ficlPrimitiveStringQuoteIm, FICL_WORD_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "sign", ficlPrimitiveSign,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "sm/rem",
+	    ficlPrimitiveSMSlashRem, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "source", ficlPrimitiveSource,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "state", ficlPrimitiveState,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "then", ficlPrimitiveEndifCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "type", ficlPrimitiveType,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "u.", ficlPrimitiveUDot,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "um*", ficlPrimitiveUMStar,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "um/mod",
+	    ficlPrimitiveUMSlashMod, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "until",
+	    ficlPrimitiveUntilCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "variable",
+	    ficlPrimitiveVariable, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "while",
+	    ficlPrimitiveWhileCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "word", ficlPrimitiveWord,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "[",
+	    ficlPrimitiveLeftBracketCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "[\']",
+	    ficlPrimitiveBracketTickCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "[char]", ficlPrimitiveCharCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "]", ficlPrimitiveRightBracket,
+	    FICL_WORD_DEFAULT);
+	/*
+	 * The Core Extensions word set...
+	 * see softcore.fr for other definitions
+	 */
+	/* "#tib" */
+	ficlDictionarySetPrimitive(dictionary, ".(", ficlPrimitiveDotParen,
+	    FICL_WORD_IMMEDIATE);
+	/* ".r" is in softcore */
+	ficlDictionarySetPrimitive(dictionary, ":noname",
+	    ficlPrimitiveColonNoName, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "?do", ficlPrimitiveQDoCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "again", ficlPrimitiveAgainCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "c\"",
+	    ficlPrimitiveCountedStringQuoteIm, FICL_WORD_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "hex", ficlPrimitiveHex,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "pad", ficlPrimitivePad,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "parse", ficlPrimitiveParse,
+	    FICL_WORD_DEFAULT);
+
+	/*
+	 * query restore-input save-input tib u.r u> unused
+	 * [FICL_VM_STATE_COMPILE]
+	 */
+	ficlDictionarySetPrimitive(dictionary, "refill", ficlPrimitiveRefill,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "source-id",
+	    ficlPrimitiveSourceID, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "to", ficlPrimitiveToValue,
+	    FICL_WORD_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "value", ficlPrimitiveConstant,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "\\", ficlPrimitiveBackslash,
+	    FICL_WORD_IMMEDIATE);
+
+	/*
+	 * Environment query values for the Core word set
+	 */
+	ficlDictionarySetConstant(environment, "/counted-string",
+	    FICL_COUNTED_STRING_MAX);
+	ficlDictionarySetConstant(environment, "/hold", FICL_PAD_SIZE);
+	ficlDictionarySetConstant(environment, "/pad", FICL_PAD_SIZE);
+	ficlDictionarySetConstant(environment, "address-unit-bits", 8);
+	ficlDictionarySetConstant(environment, "core", FICL_TRUE);
+	ficlDictionarySetConstant(environment, "core-ext", FICL_FALSE);
+	ficlDictionarySetConstant(environment, "floored", FICL_FALSE);
+	ficlDictionarySetConstant(environment, "max-char", UCHAR_MAX);
+	ficlDictionarySetConstant(environment, "max-n", LONG_MAX);
+	ficlDictionarySetConstant(environment, "max-u", ULONG_MAX);
+
+	{
+		ficl2Integer id;
+		ficlInteger low, high;
+
+		low = ULONG_MAX;
+		high = LONG_MAX;
+		FICL_2INTEGER_SET(high, low, id);
+		ficlDictionarySet2Constant(environment, "max-d", id);
+		high = ULONG_MAX;
+		FICL_2INTEGER_SET(high, low, id);
+		ficlDictionarySet2Constant(environment, "max-ud", id);
+	}
+
+	ficlDictionarySetConstant(environment, "return-stack-cells",
+	    FICL_DEFAULT_STACK_SIZE);
+	ficlDictionarySetConstant(environment, "stack-cells",
+	    FICL_DEFAULT_STACK_SIZE);
+
+	/*
+	 * The optional Double-Number word set (partial)
+	 */
+	ficlDictionarySetPrimitive(dictionary, "2constant",
+	    ficlPrimitive2Constant, FICL_WORD_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "2literal",
+	    ficlPrimitive2LiteralIm, FICL_WORD_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "2variable",
+	    ficlPrimitive2Variable, FICL_WORD_IMMEDIATE);
+	/*
+	 * D+ D- D. D.R D0< D0= D2* D2/ in softcore
+	 * D< D= D>S DABS DMAX DMIN DNEGATE in softcore
+	 * m-star-slash is TODO
+	 * M+ in softcore
+	 */
+
+	/*
+	 * DOUBLE EXT
+	 */
+	ficlDictionarySetPrimitive(dictionary, "2rot",
+	    ficlPrimitive2Rot, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "2value",
+	    ficlPrimitive2Constant, FICL_WORD_IMMEDIATE);
+	/* du< in softcore */
+	/*
+	 * The optional Exception and Exception Extensions word set
+	 */
+	ficlDictionarySetPrimitive(dictionary, "catch", ficlPrimitiveCatch,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "throw", ficlPrimitiveThrow,
+	    FICL_WORD_DEFAULT);
+
+	ficlDictionarySetConstant(environment, "exception", FICL_TRUE);
+	ficlDictionarySetConstant(environment, "exception-ext", FICL_TRUE);
+
+	/*
+	 * The optional Locals and Locals Extensions word set
+	 * see softcore.c for implementation of locals|
+	 */
+#if FICL_WANT_LOCALS
+	ficlDictionarySetPrimitive(dictionary, "doLocal",
+	    ficlPrimitiveDoLocalIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "(local)",
+	    ficlPrimitiveLocalParen, FICL_WORD_COMPILE_ONLY);
+	ficlDictionarySetPrimitive(dictionary, "(2local)",
+	    ficlPrimitive2LocalParen, FICL_WORD_COMPILE_ONLY);
+
+	ficlDictionarySetConstant(environment, "locals", FICL_TRUE);
+	ficlDictionarySetConstant(environment, "locals-ext", FICL_TRUE);
+	ficlDictionarySetConstant(environment, "#locals", FICL_MAX_LOCALS);
+#endif
+
+	/*
+	 * The optional Memory-Allocation word set
+	 */
+
+	ficlDictionarySetPrimitive(dictionary, "allocate",
+	    ficlPrimitiveAllocate, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "free", ficlPrimitiveFree,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "resize", ficlPrimitiveResize,
+	    FICL_WORD_DEFAULT);
+
+	ficlDictionarySetConstant(environment, "memory-alloc", FICL_TRUE);
+
+	/*
+	 * The optional Search-Order word set
+	 */
+	ficlSystemCompileSearch(system);
+
+	/*
+	 * The optional Programming-Tools and Programming-Tools
+	 * Extensions word set
+	 */
+	ficlSystemCompileTools(system);
+
+	/*
+	 * The optional File-Access and File-Access Extensions word set
+	 */
+#if FICL_WANT_FILE
+	ficlSystemCompileFile(system);
+#endif
+
+	/*
+	 * Ficl extras
+	 */
+	ficlDictionarySetPrimitive(dictionary, ".ver", ficlPrimitiveVersion,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, ">name", ficlPrimitiveToName,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "add-parse-step",
+	    ficlPrimitiveAddParseStep, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "body>", ficlPrimitiveFromBody,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "compile-only",
+	    ficlPrimitiveCompileOnly, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "endif", ficlPrimitiveEndifCoIm,
+	    FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "last-word",
+	    ficlPrimitiveLastWord, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "hash", ficlPrimitiveHash,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "objectify",
+	    ficlPrimitiveSetObjectFlag, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "?object",
+	    ficlPrimitiveIsObject, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "parse-word",
+	    ficlPrimitiveParseNoCopy, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "sfind", ficlPrimitiveSFind,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "sliteral",
+	    ficlPrimitiveSLiteralCoIm, FICL_WORD_COMPILE_ONLY_IMMEDIATE);
+	ficlDictionarySetPrimitive(dictionary, "sprintf", ficlPrimitiveSprintf,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "strlen", ficlPrimitiveStrlen,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "x.", ficlPrimitiveHexDot,
+	    FICL_WORD_DEFAULT);
+#if FICL_WANT_USER
+	ficlDictionarySetPrimitive(dictionary, "user", ficlPrimitiveUser,
+	    FICL_WORD_DEFAULT);
+#endif
+
+	/*
+	 * internal support words
+	 */
+	interpret = ficlDictionarySetPrimitive(dictionary, "interpret",
+	    ficlPrimitiveInterpret, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "lookup", ficlPrimitiveLookup,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "(parse-step)",
+	    ficlPrimitiveParseStepParen, FICL_WORD_DEFAULT);
+	system->exitInnerWord = ficlDictionarySetPrimitive(dictionary,
+	    "exit-inner", ficlPrimitiveExitInner, FICL_WORD_DEFAULT);
+
+	/*
+	 * Set constants representing the internal instruction words
+	 * If you want all of 'em, turn that "#if 0" to "#if 1".
+	 * By default you only get the numbers (fi0, fiNeg1, etc).
+	 */
+#define	FICL_TOKEN(token, description)	\
+	ficlDictionarySetConstant(dictionary, #token, token);
+#if 0
+#define	FICL_INSTRUCTION_TOKEN(token, description, flags)	\
+	ficlDictionarySetConstant(dictionary, #token, token);
+#else
+#define	FICL_INSTRUCTION_TOKEN(token, description, flags)
+#endif /* 0 */
+#include "ficltokens.h"
+#undef FICL_TOKEN
+#undef FICL_INSTRUCTION_TOKEN
+
+	/*
+	 * Set up system's outer interpreter loop - maybe this should
+	 * be in initSystem?
+	 */
+	system->interpreterLoop[0] = interpret;
+	system->interpreterLoop[1] = (ficlWord *)ficlInstructionBranchParen;
+	system->interpreterLoop[2] = (ficlWord *)(void *)(-2);
+
+	FICL_SYSTEM_ASSERT(system,
+	    ficlDictionaryCellsAvailable(dictionary) > 0);
+}
diff --git a/usr/src/common/ficl/search.c b/usr/src/common/ficl/search.c
new file mode 100644
index 0000000000..ae5f4a3cf6
--- /dev/null
+++ b/usr/src/common/ficl/search.c
@@ -0,0 +1,387 @@
+/*
+ * s e a r c h . c
+ * Forth Inspired Command Language
+ * 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.10 2010/08/12 13:57:22 asau 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.
+ */
+
+#include <string.h>
+#include "ficl.h"
+
+/*
+ * d e f i n i t i o n s
+ * SEARCH ( -- )
+ * Make the compilation word list the same as the first word list in the
+ * search order. Specifies that the names of subsequent definitions will
+ * be placed in the compilation word list. Subsequent changes in the search
+ * order will not affect the compilation word list.
+ */
+static void
+ficlPrimitiveDefinitions(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	FICL_VM_ASSERT(vm, dictionary);
+	if (dictionary->wordlistCount < 1) {
+		ficlVmThrowError(vm, "DEFINITIONS error - empty search order");
+	}
+
+	dictionary->compilationWordlist =
+	    dictionary->wordlists[dictionary->wordlistCount-1];
+}
+
+/*
+ * f o r t h - w o r d l i s t
+ * SEARCH ( -- wid )
+ * Return wid, the identifier of the word list that includes all standard
+ * words provided by the implementation. This word list is initially the
+ * compilation word list and is part of the initial search order.
+ */
+static void
+ficlPrimitiveForthWordlist(ficlVm *vm)
+{
+	ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist;
+	ficlStackPushPointer(vm->dataStack, hash);
+}
+
+
+/*
+ * g e t - c u r r e n t
+ * SEARCH ( -- wid )
+ * Return wid, the identifier of the compilation word list.
+ */
+static void
+ficlPrimitiveGetCurrent(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+	ficlStackPushPointer(vm->dataStack, dictionary->compilationWordlist);
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+}
+
+/*
+ * g e t - o r d e r
+ * SEARCH ( -- widn ... wid1 n )
+ * Returns the number of word lists n in the search order and the word list
+ * identifiers widn ... wid1 identifying these word lists. wid1 identifies
+ * the word list that is searched first, and widn the word list that is
+ * searched last. The search order is unaffected.
+ */
+static void
+ficlPrimitiveGetOrder(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	int wordlistCount = dictionary->wordlistCount;
+	int i;
+
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+	for (i = 0; i < wordlistCount; i++) {
+		ficlStackPushPointer(vm->dataStack, dictionary->wordlists[i]);
+	}
+
+	ficlStackPushUnsigned(vm->dataStack, wordlistCount);
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+}
+
+/*
+ * s e a r c h - w o r d l i s t
+ * SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 )
+ * Find the definition identified by the string c-addr u in the word list
+ * identified by wid. If the definition is not found, return zero. If the
+ * definition is found, return its execution token xt and one (1) if the
+ * definition is immediate, minus-one (-1) otherwise.
+ */
+static void
+ficlPrimitiveSearchWordlist(ficlVm *vm)
+{
+	ficlString name;
+	ficlUnsigned16 hashCode;
+	ficlWord *word;
+	ficlHash *hash = ficlStackPopPointer(vm->dataStack);
+
+	name.length = (ficlUnsigned8)ficlStackPopUnsigned(vm->dataStack);
+	name.text = ficlStackPopPointer(vm->dataStack);
+	hashCode = ficlHashCode(name);
+
+	ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_TRUE);
+	word = ficlHashLookup(hash, name, hashCode);
+	ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_FALSE);
+
+	if (word) {
+		ficlStackPushPointer(vm->dataStack, word);
+		ficlStackPushInteger(vm->dataStack,
+		    (ficlWordIsImmediate(word) ? 1 : -1));
+	} else {
+		ficlStackPushUnsigned(vm->dataStack, 0);
+	}
+}
+
+/*
+ * s e t - c u r r e n t
+ * SEARCH ( wid -- )
+ * Set the compilation word list to the word list identified by wid.
+ */
+static void
+ficlPrimitiveSetCurrent(ficlVm *vm)
+{
+	ficlHash *hash = ficlStackPopPointer(vm->dataStack);
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+	dictionary->compilationWordlist = hash;
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+}
+
+/*
+ *                      s e t - o r d e r
+ * SEARCH ( widn ... wid1 n -- )
+ * Set the search order to the word lists identified by widn ... wid1.
+ * Subsequently, word list wid1 will be searched first, and word list
+ * widn searched last. If n is zero, empty the search order. If n is minus
+ * one, set the search order to the implementation-defined minimum
+ * search order. The minimum search order shall include the words
+ * FORTH-WORDLIST and SET-ORDER. A system shall allow n to
+ * be at least eight.
+ */
+static void
+ficlPrimitiveSetOrder(ficlVm *vm)
+{
+	int i;
+	int wordlistCount = ficlStackPopInteger(vm->dataStack);
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	if (wordlistCount > FICL_MAX_WORDLISTS) {
+		ficlVmThrowError(vm,
+		    "set-order error: list would be too large");
+	}
+
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+
+	if (wordlistCount >= 0) {
+		dictionary->wordlistCount = wordlistCount;
+		for (i = wordlistCount-1; i >= 0; --i) {
+			dictionary->wordlists[i] =
+			    ficlStackPopPointer(vm->dataStack);
+		}
+	} else {
+		ficlDictionaryResetSearchOrder(dictionary);
+	}
+
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+}
+
+/*
+ * f i c l - w o r d l i s t
+ * SEARCH ( -- wid )
+ * Create a new empty word list, returning its word list identifier wid.
+ * The new word list may be returned from a pool of preallocated word
+ * lists or may be dynamically allocated in data space. A system shall
+ * allow the creation of at least 8 new word lists in addition to any
+ * provided as part of the system.
+ * Notes:
+ * 1. Ficl creates a new single-list hash in the dictionary and returns
+ *    its address.
+ * 2. ficl-wordlist takes an arg off the stack indicating the number of
+ *    hash entries in the wordlist. Ficl 2.02 and later define WORDLIST as
+ *    : wordlist 1 ficl-wordlist ;
+ */
+static void
+ficlPrimitiveFiclWordlist(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlHash *hash;
+	ficlUnsigned nBuckets;
+
+	FICL_STACK_CHECK(vm->dataStack, 1, 1);
+
+	nBuckets = ficlStackPopUnsigned(vm->dataStack);
+	hash = ficlDictionaryCreateWordlist(dictionary, nBuckets);
+	ficlStackPushPointer(vm->dataStack, hash);
+}
+
+/*
+ * S E A R C H >
+ * Ficl  ( -- wid )
+ * Pop wid off the search order. Error if the search order is empty
+ */
+static void
+ficlPrimitiveSearchPop(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	int wordlistCount;
+
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+	wordlistCount = dictionary->wordlistCount;
+	if (wordlistCount == 0) {
+		ficlVmThrowError(vm, "search> error: empty search order");
+	}
+	ficlStackPushPointer(vm->dataStack,
+	    dictionary->wordlists[--dictionary->wordlistCount]);
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+}
+
+/*
+ * > S E A R C H
+ * Ficl  ( wid -- )
+ * Push wid onto the search order. Error if the search order is full.
+ */
+static void
+ficlPrimitiveSearchPush(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+	if (dictionary->wordlistCount > FICL_MAX_WORDLISTS) {
+		ficlVmThrowError(vm, ">search error: search order overflow");
+	}
+	dictionary->wordlists[dictionary->wordlistCount++] =
+	    ficlStackPopPointer(vm->dataStack);
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+}
+
+/*
+ * W I D - G E T - N A M E
+ * Ficl  ( wid -- c-addr u )
+ * Get wid's (optional) name and push onto stack as a counted string
+ */
+static void
+ficlPrimitiveWidGetName(ficlVm *vm)
+{
+	ficlHash *hash;
+	char *name;
+	ficlInteger length;
+	ficlCell c;
+
+	hash = ficlVmPop(vm).p;
+	name = hash->name;
+
+	if (name != NULL)
+		length = strlen(name);
+	else
+		length = 0;
+
+	c.p = name;
+	ficlVmPush(vm, c);
+
+	c.i = length;
+	ficlVmPush(vm, c);
+}
+
+/*
+ * W I D - S E T - N A M E
+ * Ficl  ( wid c-addr -- )
+ * Set wid's name pointer to the \0 terminated string address supplied
+ */
+static void
+ficlPrimitiveWidSetName(ficlVm *vm)
+{
+	char *name = (char *)ficlVmPop(vm).p;
+	ficlHash *hash = ficlVmPop(vm).p;
+	hash->name = name;
+}
+
+/*
+ * setParentWid
+ * Ficl
+ * setparentwid   ( parent-wid wid -- )
+ * Set WID's link field to the parent-wid. search-wordlist will
+ * iterate through all the links when finding words in the child wid.
+ */
+static void
+ficlPrimitiveSetParentWid(ficlVm *vm)
+{
+	ficlHash *parent, *child;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 0);
+
+	child  = (ficlHash *)ficlStackPopPointer(vm->dataStack);
+	parent = (ficlHash *)ficlStackPopPointer(vm->dataStack);
+
+	child->link = parent;
+}
+
+/*
+ * f i c l C o m p i l e S e a r c h
+ * Builds the primitive wordset and the environment-query namespace.
+ */
+void
+ficlSystemCompileSearch(ficlSystem *system)
+{
+	ficlDictionary *dictionary = ficlSystemGetDictionary(system);
+	ficlDictionary *environment = ficlSystemGetEnvironment(system);
+
+	FICL_SYSTEM_ASSERT(system, dictionary);
+	FICL_SYSTEM_ASSERT(system, environment);
+
+	/*
+	 * optional SEARCH-ORDER word set
+	 */
+	ficlDictionarySetPrimitive(dictionary, ">search",
+	    ficlPrimitiveSearchPush, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "search>",
+	    ficlPrimitiveSearchPop, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "definitions",
+	    ficlPrimitiveDefinitions, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "forth-wordlist",
+	    ficlPrimitiveForthWordlist, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "get-current",
+	    ficlPrimitiveGetCurrent, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "get-order",
+	    ficlPrimitiveGetOrder, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "search-wordlist",
+	    ficlPrimitiveSearchWordlist, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "set-current",
+	    ficlPrimitiveSetCurrent, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "set-order",
+	    ficlPrimitiveSetOrder, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "ficl-wordlist",
+	    ficlPrimitiveFiclWordlist, FICL_WORD_DEFAULT);
+
+	/*
+	 * Set SEARCH environment query values
+	 */
+	ficlDictionarySetConstant(environment, "search-order", FICL_TRUE);
+	ficlDictionarySetConstant(environment, "search-order-ext", FICL_TRUE);
+	ficlDictionarySetConstant(environment, "wordlists", FICL_MAX_WORDLISTS);
+	ficlDictionarySetPrimitive(dictionary, "wid-get-name",
+	    ficlPrimitiveWidGetName, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "wid-set-name",
+	    ficlPrimitiveWidSetName, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "wid-set-super",
+	    ficlPrimitiveSetParentWid, FICL_WORD_DEFAULT);
+}
diff --git a/usr/src/common/ficl/softcore/classes.fr b/usr/src/common/ficl/softcore/classes.fr
new file mode 100644
index 0000000000..f392c5c8a5
--- /dev/null
+++ b/usr/src/common/ficl/softcore/classes.fr
@@ -0,0 +1,172 @@
+S" FICL_WANT_OOP" ENVIRONMENT? drop [if]
+\ ** ficl/softwords/classes.fr
+\ ** F I C L   2 . 0   C L A S S E S
+\ john sadler  1 sep 98
+\ Needs oop.fr
+
+.( loading ficl utility classes ) cr
+also oop definitions
+
+\ REF subclass holds a pointer to an object. It's
+\ mainly for aggregation to help in making data structures.
+\
+object subclass c-ref
+    cell: .class
+    cell: .instance
+
+	: get   ( inst class -- refinst refclass )
+		drop 2@ ;
+	: set   ( refinst refclass inst class -- )
+		drop 2! ;
+end-class
+
+object subclass c-byte
+	char: .payload
+
+	: get  drop c@ ;
+	: set  drop c! ;
+end-class
+
+object subclass c-2byte
+	2 chars: .payload
+
+	: get  drop w@ ;
+	: set  drop w! ;
+end-class
+
+object subclass c-4byte
+	4 chars: .payload
+
+	: get  drop q@ ;
+	: set  drop q! ;
+end-class
+
+
+object subclass c-cell
+	cell: .payload
+
+	: get  drop @ ;
+	: set  drop ! ;
+end-class
+
+
+\ ** C - P T R
+\ Base class for pointers to scalars (not objects).
+\ Note: use c-ref to make references to objects. C-ptr
+\ subclasses refer to untyped quantities of various sizes.
+
+\ Derived classes must specify the size of the thing
+\ they point to, and supply get and set methods.
+
+\ All derived classes must define the @size method:
+\ @size ( inst class -- addr-units )
+\ Returns the size in address units of the thing the pointer
+\ refers to.
+object subclass c-ptr
+    c-cell obj: .addr
+
+    \ get the value of the pointer
+    : get-ptr   ( inst class -- addr )
+        c-ptr  => .addr
+        c-cell => get
+    ;
+
+    \ set the pointer to address supplied
+    : set-ptr   ( addr inst class -- )
+        c-ptr  => .addr
+        c-cell => set
+    ;
+
+    \ force the pointer to be null
+	: clr-ptr
+	    0 -rot  c-ptr => .addr  c-cell => set
+	;
+
+    \ return flag indicating null-ness
+	: ?null     ( inst class -- flag )
+	    c-ptr => get-ptr 0=
+	;
+
+    \ increment the pointer in place
+    : inc-ptr   ( inst class -- )
+        2dup 2dup                   ( i c i c i c )
+        c-ptr => get-ptr  -rot      ( i c addr i c )
+        --> @size  +  -rot          ( addr' i c )
+        c-ptr => set-ptr
+    ;
+
+    \ decrement the pointer in place
+    : dec-ptr    ( inst class -- )
+        2dup 2dup                   ( i c i c i c )
+        c-ptr => get-ptr  -rot      ( i c addr i c )
+        --> @size  -  -rot          ( addr' i c )
+        c-ptr => set-ptr
+    ;
+
+    \ index the pointer in place
+    : index-ptr   { index 2:this -- }
+        this --> get-ptr              ( addr )
+        this --> @size  index *  +    ( addr' )
+        this --> set-ptr
+    ;
+
+end-class
+
+
+\ ** C - C E L L P T R
+\ Models a pointer to cell (a 32 or 64 bit scalar).
+c-ptr subclass c-cellPtr
+    : @size   2drop  1 cells ;
+    \ fetch and store through the pointer
+	: get   ( inst class -- cell )
+        c-ptr => get-ptr @
+    ;
+	: set   ( value inst class -- )
+        c-ptr => get-ptr !
+    ;
+end-class
+
+
+\ ** C - 4 B Y T E P T R
+\ Models a pointer to a quadbyte scalar
+c-ptr subclass c-4bytePtr
+    : @size   2drop  4  ;
+    \ fetch and store through the pointer
+	: get   ( inst class -- value )
+        c-ptr => get-ptr q@
+    ;
+	: set   ( value inst class -- )
+        c-ptr => get-ptr q!
+    ;
+ end-class
+
+\ ** C - 2 B Y T E P T R
+\ Models a pointer to a 16 bit scalar
+c-ptr subclass c-2bytePtr
+    : @size   2drop  2  ;
+    \ fetch and store through the pointer
+	: get   ( inst class -- value )
+        c-ptr => get-ptr w@
+    ;
+	: set   ( value inst class -- )
+        c-ptr => get-ptr w!
+    ;
+end-class
+
+
+\ ** C - B Y T E P T R
+\ Models a pointer to an 8 bit scalar
+c-ptr subclass c-bytePtr
+    : @size   2drop  1  ;
+    \ fetch and store through the pointer
+	: get   ( inst class -- value )
+        c-ptr => get-ptr c@
+    ;
+	: set   ( value inst class -- )
+        c-ptr => get-ptr c!
+    ;
+end-class
+
+
+previous definitions
+[endif]
diff --git a/usr/src/common/ficl/softcore/ficl.fr b/usr/src/common/ficl/softcore/ficl.fr
new file mode 100644
index 0000000000..80aa774599
--- /dev/null
+++ b/usr/src/common/ficl/softcore/ficl.fr
@@ -0,0 +1,66 @@
+\ ** ficl/softwords/softcore.fr
+\ ** FICL soft extensions
+\ ** John Sadler (john_sadler@alum.mit.edu)
+\ ** September, 1998
+
+S" FICL_WANT_USER" ENVIRONMENT? drop [if]
+\ ** Ficl USER variables
+\ ** See words.c for primitive def'n of USER
+variable nUser  0 nUser !
+: user   \ name ( -- )
+    nUser dup @ user 1 swap +! ;
+
+[endif]
+
+
+
+S" FICL_WANT_LOCALS" ENVIRONMENT? drop [if]
+
+\ ** LOCAL EXT word set
+
+: locals|  ( name...name | -- )
+    begin
+        bl word   count
+        dup 0= abort" where's the delimiter??"
+        over c@
+        [char] | - over 1- or
+    while
+        (local)
+    repeat 2drop   0 0 (local)
+; immediate
+
+: local  ( name -- )  bl word count (local) ;  immediate
+
+: 2local  ( name -- ) bl word count (2local) ; immediate
+
+: end-locals  ( -- )  0 0 (local) ;  immediate
+
+
+\ 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
+	;
+
+[endif]
+
+\ end-of-file
diff --git a/usr/src/common/ficl/softcore/ficlclass.fr b/usr/src/common/ficl/softcore/ficlclass.fr
new file mode 100644
index 0000000000..f2db84980f
--- /dev/null
+++ b/usr/src/common/ficl/softcore/ficlclass.fr
@@ -0,0 +1,84 @@
+S" FICL_WANT_OOP" ENVIRONMENT? drop [if]
+\ ** 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
+
+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/usr/src/common/ficl/softcore/ficllocal.fr b/usr/src/common/ficl/softcore/ficllocal.fr
new file mode 100644
index 0000000000..74ae40f475
--- /dev/null
+++ b/usr/src/common/ficl/softcore/ficllocal.fr
@@ -0,0 +1,46 @@
+\ ** ficl/softwords/ficllocal.fr
+\ ** stack comment style local syntax...
+\ {{ a b c -- d e }}
+\ variables before the "--" are initialized in reverse order
+\ from the stack. Those after the "--" are zero initialized
+\ Uses locals...
+\ locstate: 0 = looking for -- or }}
+\           1 = found --
+hide
+0 constant zero
+
+: ?--   s" --" compare 0= ;
+: ?}}   s" }}" compare 0= ;
+
+set-current
+
+: {{
+    0 dup  locals| nLocs locstate |
+    begin
+        parse-word
+        ?dup 0= abort" Error: out of text without seeing }}"
+        2dup 2dup  ?-- -rot ?}} or 0=
+    while
+        nLocs 1+ to nLocs
+    repeat
+
+    ?-- if 1 to locstate endif
+
+    nLocs 0 do
+        (local)
+    loop
+
+    locstate 1 = if
+        begin
+            parse-word
+            2dup ?}} 0=
+        while
+            postpone zero  (local)
+        repeat
+        2drop
+    endif
+
+    0 0 (local)
+; immediate compile-only
+
+previous
diff --git a/usr/src/common/ficl/softcore/fileaccess.fr b/usr/src/common/ficl/softcore/fileaccess.fr
new file mode 100644
index 0000000000..2c192ad6e5
--- /dev/null
+++ b/usr/src/common/ficl/softcore/fileaccess.fr
@@ -0,0 +1,22 @@
+S" FICL_WANT_FILE" ENVIRONMENT? drop [if]
+\ **
+\ ** File Access words for ficl
+\ ** submitted by Larry Hastings, larry@hastings.org
+\ **
+
+: r/o 1 ;
+: r/w 3 ;
+: w/o 2 ;
+: bin 8 or ;
+
+: included
+    r/o bin open-file 0= if
+        include-file
+    else
+        drop
+    endif
+    ;
+
+: include parse-word included ;
+
+[endif]
diff --git a/usr/src/common/ficl/softcore/forml.fr b/usr/src/common/ficl/softcore/forml.fr
new file mode 100644
index 0000000000..8e0896dcd5
--- /dev/null
+++ b/usr/src/common/ficl/softcore/forml.fr
@@ -0,0 +1,71 @@
+\ examples from FORML conference paper Nov 98
+\ sadler
+.( 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/usr/src/common/ficl/softcore/freebsd.fr b/usr/src/common/ficl/softcore/freebsd.fr
new file mode 100644
index 0000000000..9b051f8d64
--- /dev/null
+++ b/usr/src/common/ficl/softcore/freebsd.fr
@@ -0,0 +1,37 @@
+\ ** Copyright (c) 1998 Daniel C. Sobral <dcs@freebsd.org>
+\ ** All rights reserved.
+\ **
+\ ** 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$
+
+\ Words for use in scripts:
+\ % ignore errors here
+\ $ echo this line
+
+: tib> source >in @ tuck over >in ! - >r + r> ;
+: % tib> ['] evaluate catch drop ;
+: $ tib> 2dup type cr evaluate ;
+: ptov 0xa000 - ;
+: vtop 0xa000 + ;
+
+\ ** E N D   F R E E B S D . F R
diff --git a/usr/src/common/ficl/softcore/ifbrack.fr b/usr/src/common/ficl/softcore/ifbrack.fr
new file mode 100644
index 0000000000..990eaaf302
--- /dev/null
+++ b/usr/src/common/ficl/softcore/ifbrack.fr
@@ -0,0 +1,48 @@
+\ ** ficl/softwords/ifbrack.fr
+\ ** ANS conditional compile directives [if] [else] [then]
+\ ** Requires ficl 2.0 or greater...
+
+hide
+
+: ?[if]   ( c-addr u -- c-addr u flag )
+    2dup s" [if]" compare-insensitive 0=
+;
+
+: ?[else]   ( c-addr u -- c-addr u flag )
+    2dup s" [else]" compare-insensitive 0=
+;
+
+: ?[then]   ( c-addr u -- c-addr u flag )
+    2dup s" [then]" compare-insensitive 0= >r
+    2dup s" [endif]" compare-insensitive 0= r>
+    or
+;
+
+set-current
+
+: [else]  ( -- )
+    1                                     \ ( level )
+    begin
+      begin
+        parse-word dup  while             \ ( level addr len )
+        ?[if] if                          \ ( level addr len )
+            2drop 1+                      \ ( level )
+        else                              \ ( level addr len )
+            ?[else] if                    \ ( level addr len )
+                 2drop 1- dup if 1+ endif
+            else
+                ?[then] if 2drop 1- else 2drop endif
+            endif
+        endif ?dup 0=  if exit endif      \ level
+      repeat  2drop                       \ level
+    refill 0= until                       \ level
+    drop
+;  immediate
+
+: [if]  ( flag -- )
+0= if postpone [else] then ;  immediate
+
+: [then]  ( -- )  ;  immediate
+: [endif]  ( -- )  ;  immediate
+
+previous
diff --git a/usr/src/common/ficl/softcore/jhlocal.fr b/usr/src/common/ficl/softcore/jhlocal.fr
new file mode 100644
index 0000000000..e03f860d36
--- /dev/null
+++ b/usr/src/common/ficl/softcore/jhlocal.fr
@@ -0,0 +1,226 @@
+S" FICL_WANT_LOCALS" ENVIRONMENT? drop [if]
+\ ** ficl/softwords/jhlocal.fr
+\ ** stack comment style local syntax...
+\ { a b c | cleared -- d e }
+\ variables before the "|" are initialized in reverse order
+\ from the stack. Those after the "|" are zero initialized.
+\ Anything between "--" and "}" is treated as comment
+\ Uses locals...
+\ locstate: 0 = looking for | or -- or }}
+\           1 = found |
+\           2 = found --
+\           3 = found }
+\           4 = end of line
+\
+\ revised 2 June 2000 - { | a -- } now works correctly
+.( loading Johns-Hopkins locals ) cr
+hide
+
+\ What does this do?  It's equivalent to "postpone 0", but faster.
+\ "ficlInstruction0" is the FICL instruction for "push a 0 on the data stack".
+\ --lch
+: compiled-zero ficlInstruction0 , ;
+S" FICL_WANT_FLOAT" ENVIRONMENT? drop [if]
+\ And this is the instruction for a floating-point 0 (0.0e).
+: compiled-float-zero ficlInstructionF0 , ;
+[endif]
+
+: ?--   ( c-addr u -- c-addr u flag )
+    2dup s" --" compare 0= ;
+: ?}    ( c-addr u -- c-addr u flag )
+    2dup s" }"  compare 0= ;
+: ?|    ( c-addr u -- c-addr u flag )
+    2dup s" |"  compare 0= ;
+
+1 constant local-is-double
+2 constant local-is-float
+
+\ parse-local-prefix-flags
+\
+\ Parses single-letter prefix flags from the name of a local, and returns
+\ a bitfield of all flags (local-is-float | local-is-double) appropriate
+\ for the local.  Adjusts the "c-addr u" of the name to remove any prefix.
+\
+\ Handled single-letter prefix flags:
+\	1  single-cell
+\	2  double-cell
+\	d  double-cell
+\	f  floating-point (use floating stack)
+\	i  integer (use data stack)
+\	s  single-cell
+\ Specify as many as you like; later flags have precidence.
+\ Thus, "f2:foo" and "2is2f:foo" are both double-cell floats.
+\
+\ If you don't specify anything after the colon, like "f2:",
+\ there is no legal prefix, so "2f:" becomes the name of the
+\ (single-cell data stack) local.
+\
+\ For convention, the "f" is preferred first.
+
+: parse-local-prefix-flags ( c-addr u -- c-addr u flags )
+    0 0 0 locals| stop-loop colon-offset flags   u c-addr |
+
+    \ if the first character is a colon, remove the colon and return 0.
+    c-addr c@ [char] : =
+    if
+        over over 0  exit
+    endif
+
+    u 0 do
+        c-addr i + c@
+       case
+           [char] 1 of  flags local-is-double invert and  to flags  endof
+           [char] 2 of  flags local-is-double or          to flags  endof
+           [char] d of  flags local-is-double or          to flags  endof
+           [char] f of  flags local-is-float  or          to flags  endof
+           [char] i of  flags local-is-float  invert and  to flags  endof
+           [char] s of  flags local-is-double invert and  to flags  endof
+           [char] : of  i 1+ to colon-offset   1 to stop-loop  endof
+           1 to stop-loop
+       endcase
+    stop-loop  if leave  endif
+    loop
+
+    colon-offset 0=
+    colon-offset u =
+    or
+    if
+\        ." Returning variable name -- " c-addr u type ."  -- No flags." cr
+        c-addr u 0 exit
+    endif
+
+    c-addr colon-offset +
+    u colon-offset -
+\    ." Returning variable name -- " 2dup type ."  -- Flags: " flags . cr
+    flags
+;
+
+: ?delim   ( c-addr u -- state | c-addr u 0 )
+    ?|  if  2drop 1 exit endif
+    ?-- if  2drop 2 exit endif
+    ?}  if  2drop 3 exit endif
+    dup 0=
+        if  2drop 4 exit endif
+    0
+;
+
+
+
+set-current
+
+S" FICL_WANT_FLOAT" ENVIRONMENT? drop [if]
+: {
+    0 0 0 locals| flags local-state nLocals |
+
+    \ stack locals until we hit a delimiter
+    begin
+        parse-word ?delim  dup to local-state
+    0= while
+        nLocals 1+ to nLocals
+    repeat
+
+    \ now unstack the locals
+    nLocals 0 ?do
+            parse-local-prefix-flags to flags
+            flags local-is-double and if
+                flags local-is-float and if (f2local) else (2local) endif
+            else
+                flags local-is-float and if (flocal) else (local) endif
+            endif
+	loop   \ ( )
+
+    \ zero locals until -- or }
+    local-state 1 = if
+        begin
+            parse-word
+            ?delim dup to local-state
+        0= while
+            parse-local-prefix-flags to flags
+            flags local-is-double and if
+                flags local-is-float and if
+                    compiled-float-zero compiled-float-zero (f2local)
+                else
+                    compiled-zero compiled-zero (2local)
+                endif
+            else
+                flags local-is-float and if
+                    compiled-float-zero (flocal)
+                else
+                    compiled-zero (local)
+                endif
+            endif
+        repeat
+    endif
+
+    0 0 (local)
+
+    \ toss words until }
+    \ (explicitly allow | and -- in the comment)
+    local-state 2 = if
+        begin
+            parse-word
+            ?delim dup  to local-state
+        3 < while
+            local-state 0=  if 2drop endif
+        repeat
+    endif
+
+    local-state 3 <> abort" syntax error in { } local line"
+; immediate compile-only
+
+[else]
+
+: {
+    0 0 0 locals| flags local-state nLocals |
+
+    \ stack locals until we hit a delimiter
+    begin
+        parse-word ?delim  dup to local-state
+    0= while
+        nLocals 1+ to nLocals
+    repeat
+
+    \ now unstack the locals
+    nLocals 0 ?do
+            parse-local-prefix-flags to flags
+            flags local-is-double and if
+                (2local)
+            else
+                (local)
+            endif
+	loop   \ ( )
+
+    \ zero locals until -- or }
+    local-state 1 = if
+        begin
+            parse-word
+            ?delim dup to local-state
+        0= while
+            parse-local-prefix-flags to flags
+            flags local-is-double and if
+                compiled-zero compiled-zero (2local)
+            else
+                compiled-zero (local)
+            endif
+        repeat
+    endif
+
+    0 0 (local)
+
+    \ toss words until }
+    \ (explicitly allow | and -- in the comment)
+    local-state 2 = if
+        begin
+            parse-word
+            ?delim dup  to local-state
+        3 < while
+            local-state 0=  if 2drop endif
+        repeat
+    endif
+
+    local-state 3 <> abort" syntax error in { } local line"
+; immediate compile-only
+[endif]
+
+previous
+[endif]
diff --git a/usr/src/common/ficl/softcore/lz4.c b/usr/src/common/ficl/softcore/lz4.c
new file mode 100644
index 0000000000..abff0700ed
--- /dev/null
+++ b/usr/src/common/ficl/softcore/lz4.c
@@ -0,0 +1,1035 @@
+/*
+ * LZ4 - Fast LZ compression algorithm
+ * Header File
+ * Copyright (C) 2011-2013, Yann Collet.
+ * BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ *     * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *     * 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 COPYRIGHT HOLDERS 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 COPYRIGHT
+ * OWNER 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.
+ *
+ * You can contact the author at :
+ * - LZ4 homepage : http://fastcompression.blogspot.com/p/lz4.html
+ * - LZ4 source repository : http://code.google.com/p/lz4/
+ */
+
+#include <sys/types.h>
+#include <sys/byteorder.h>
+#include <assert.h>
+#include <string.h>
+#include <umem.h>
+
+size_t lz4_compress(void *, void *, size_t, size_t, int);
+int lz4_decompress(void *, void *, size_t, size_t, int);
+static int real_LZ4_compress(const char *source, char *dest, int isize,
+    int osize);
+static int LZ4_uncompress_unknownOutputSize(const char *source, char *dest,
+    int isize, int maxOutputSize);
+static int LZ4_compressCtx(void *ctx, const char *source, char *dest,
+    int isize, int osize);
+static int LZ4_compress64kCtx(void *ctx, const char *source, char *dest,
+    int isize, int osize);
+
+/*ARGSUSED*/
+size_t
+lz4_compress(void *s_start, void *d_start, size_t s_len, size_t d_len, int n)
+{
+	uint32_t bufsiz;
+	char *dest = d_start;
+
+	assert(d_len >= sizeof (bufsiz));
+
+	bufsiz = real_LZ4_compress(s_start, &dest[sizeof (bufsiz)], s_len,
+	    d_len - sizeof (bufsiz));
+
+	/* Signal an error if the compression routine returned zero. */
+	if (bufsiz == 0)
+		return (s_len);
+
+	/*
+	 * Encode the compresed buffer size at the start. We'll need this in
+	 * decompression to counter the effects of padding which might be
+	 * added to the compressed buffer and which, if unhandled, would
+	 * confuse the hell out of our decompression function.
+	 */
+	*(uint32_t *)dest = BE_32(bufsiz);
+
+	return (bufsiz + sizeof (bufsiz));
+}
+
+/*ARGSUSED*/
+int
+lz4_decompress(void *s_start, void *d_start, size_t s_len, size_t d_len, int n)
+{
+	const char *src = s_start;
+	uint32_t bufsiz = BE_IN32(src);
+
+	/* invalid compressed buffer size encoded at start */
+	if (bufsiz + sizeof (bufsiz) > s_len)
+		return (1);
+
+	/*
+	 * Returns 0 on success (decompression function returned non-negative)
+	 * and non-zero on failure (decompression function returned negative.
+	 */
+	return (LZ4_uncompress_unknownOutputSize(&src[sizeof (bufsiz)],
+	    d_start, bufsiz, d_len) < 0);
+}
+
+/*
+ * LZ4 API Description:
+ *
+ * Simple Functions:
+ * real_LZ4_compress() :
+ *	isize  : is the input size. Max supported value is ~1.9GB
+ *	return : the number of bytes written in buffer dest
+ *		or 0 if the compression fails (if LZ4_COMPRESSMIN is set).
+ *	note : destination buffer must be already allocated.
+ *		destination buffer must be sized to handle worst cases
+ *		situations (input data not compressible)
+ *
+ * Advanced Functions
+ *
+ * LZ4_uncompress_unknownOutputSize() :
+ *	isize  : is the input size, therefore the compressed size
+ *	maxOutputSize : is the size of the destination buffer (which must be
+ *		already allocated)
+ *	return : the number of bytes decoded in the destination buffer
+ *		(necessarily <= maxOutputSize). If the source stream is
+ *		malformed, the function will stop decoding and return a
+ *		negative result, indicating the byte position of the faulty
+ *		instruction. This function never writes beyond dest +
+ *		maxOutputSize, and is therefore protected against malicious
+ *		data packets.
+ *	note   : Destination buffer must be already allocated.
+ *
+ * LZ4_compressCtx() :
+ *	This function explicitly handles the CTX memory structure.
+ *
+ *	ILLUMOS CHANGES: the CTX memory structure must be explicitly allocated
+ *	by the caller (either on the stack or using kmem_zalloc). Passing NULL
+ *	isn't valid.
+ *
+ * LZ4_compress64kCtx() :
+ *	Same as LZ4_compressCtx(), but specific to small inputs (<64KB).
+ *	isize *Must* be <64KB, otherwise the output will be corrupted.
+ *
+ *	ILLUMOS CHANGES: the CTX memory structure must be explicitly allocated
+ *	by the caller (either on the stack or using kmem_zalloc). Passing NULL
+ *	isn't valid.
+ */
+
+/*
+ * Tuning parameters
+ */
+
+/*
+ * COMPRESSIONLEVEL: Increasing this value improves compression ratio
+ *	 Lowering this value reduces memory usage. Reduced memory usage
+ *	typically improves speed, due to cache effect (ex: L1 32KB for Intel,
+ *	L1 64KB for AMD). Memory usage formula : N->2^(N+2) Bytes
+ *	(examples : 12 -> 16KB ; 17 -> 512KB)
+ */
+#define	COMPRESSIONLEVEL 12
+
+/*
+ * NOTCOMPRESSIBLE_CONFIRMATION: Decreasing this value will make the
+ *	algorithm skip faster data segments considered "incompressible".
+ *	This may decrease compression ratio dramatically, but will be
+ *	faster on incompressible data. Increasing this value will make
+ *	the algorithm search more before declaring a segment "incompressible".
+ *	This could improve compression a bit, but will be slower on
+ *	incompressible data. The default value (6) is recommended.
+ */
+#define	NOTCOMPRESSIBLE_CONFIRMATION 6
+
+/*
+ * BIG_ENDIAN_NATIVE_BUT_INCOMPATIBLE: This will provide a boost to
+ * performance for big endian cpu, but the resulting compressed stream
+ * will be incompatible with little-endian CPU. You can set this option
+ * to 1 in situations where data will stay within closed environment.
+ * This option is useless on Little_Endian CPU (such as x86).
+ */
+/* #define	BIG_ENDIAN_NATIVE_BUT_INCOMPATIBLE 1 */
+
+/*
+ * CPU Feature Detection
+ */
+
+/* 32 or 64 bits ? */
+#if (defined(__x86_64__) || defined(__x86_64) || defined(__amd64__) || \
+    defined(__amd64) || defined(__ppc64__) || defined(_WIN64) || \
+    defined(__LP64__) || defined(_LP64))
+#define	LZ4_ARCH64 1
+#else
+#define	LZ4_ARCH64 0
+#endif
+
+/*
+ * Limits the amount of stack space that the algorithm may consume to hold
+ * the compression lookup table. The value `9' here means we'll never use
+ * more than 2k of stack (see above for a description of COMPRESSIONLEVEL).
+ * If more memory is needed, it is allocated from the heap.
+ */
+#define	STACKLIMIT 9
+
+/*
+ * Little Endian or Big Endian?
+ * Note: overwrite the below #define if you know your architecture endianess.
+ */
+#if (defined(__BIG_ENDIAN__) || defined(__BIG_ENDIAN) || \
+	defined(_BIG_ENDIAN) || defined(_ARCH_PPC) || defined(__PPC__) || \
+	defined(__PPC) || defined(PPC) || defined(__powerpc__) || \
+	defined(__powerpc) || defined(powerpc) || \
+	((defined(__BYTE_ORDER__)&&(__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__))))
+#define	LZ4_BIG_ENDIAN 1
+#else
+/*
+ * Little Endian assumed. PDP Endian and other very rare endian format
+ * are unsupported.
+ */
+#endif
+
+/*
+ * Unaligned memory access is automatically enabled for "common" CPU,
+ * such as x86. For others CPU, the compiler will be more cautious, and
+ * insert extra code to ensure aligned access is respected. If you know
+ * your target CPU supports unaligned memory access, you may want to
+ * force this option manually to improve performance
+ */
+#if defined(__ARM_FEATURE_UNALIGNED)
+#define	LZ4_FORCE_UNALIGNED_ACCESS 1
+#endif
+
+#ifdef __sparc
+#define	LZ4_FORCE_SW_BITCOUNT
+#endif
+
+/*
+ * Compiler Options
+ */
+#if __STDC_VERSION__ >= 199901L	/* C99 */
+/* "restrict" is a known keyword */
+#else
+/* Disable restrict */
+#define	restrict
+#endif
+
+#define	GCC_VERSION (__GNUC__ * 100 + __GNUC_MINOR__)
+
+#ifdef _MSC_VER
+/* Visual Studio */
+/* Visual is not C99, but supports some kind of inline */
+#define	inline __forceinline
+#if LZ4_ARCH64
+/* For Visual 2005 */
+#pragma intrinsic(_BitScanForward64)
+#pragma intrinsic(_BitScanReverse64)
+#else /* !LZ4_ARCH64 */
+/* For Visual 2005 */
+#pragma intrinsic(_BitScanForward)
+#pragma intrinsic(_BitScanReverse)
+#endif /* !LZ4_ARCH64 */
+#endif /* _MSC_VER */
+
+#ifdef _MSC_VER
+#define	lz4_bswap16(x) _byteswap_ushort(x)
+#else /* !_MSC_VER */
+#define	lz4_bswap16(x) ((unsigned short int) ((((x) >> 8) & 0xffu) | \
+	(((x) & 0xffu) << 8)))
+#endif /* !_MSC_VER */
+
+#if (GCC_VERSION >= 302) || (__INTEL_COMPILER >= 800) || defined(__clang__)
+#define	expect(expr, value)    (__builtin_expect((expr), (value)))
+#else
+#define	expect(expr, value)    (expr)
+#endif
+
+#define	likely(expr)	expect((expr) != 0, 1)
+#define	unlikely(expr)	expect((expr) != 0, 0)
+
+/* Basic types */
+#if defined(_MSC_VER)
+/* Visual Studio does not support 'stdint' natively */
+#define	BYTE	unsigned __int8
+#define	U16	unsigned __int16
+#define	U32	unsigned __int32
+#define	S32	__int32
+#define	U64	unsigned __int64
+#else /* !defined(_MSC_VER) */
+#define	BYTE	uint8_t
+#define	U16	uint16_t
+#define	U32	uint32_t
+#define	S32	int32_t
+#define	U64	uint64_t
+#endif /* !defined(_MSC_VER) */
+
+#ifndef LZ4_FORCE_UNALIGNED_ACCESS
+#pragma pack(1)
+#endif
+
+typedef struct _U16_S {
+	U16 v;
+} U16_S;
+typedef struct _U32_S {
+	U32 v;
+} U32_S;
+typedef struct _U64_S {
+	U64 v;
+} U64_S;
+
+#ifndef LZ4_FORCE_UNALIGNED_ACCESS
+#pragma pack()
+#endif
+
+#define	A64(x) (((U64_S *)(x))->v)
+#define	A32(x) (((U32_S *)(x))->v)
+#define	A16(x) (((U16_S *)(x))->v)
+
+/*
+ * Constants
+ */
+#define	MINMATCH 4
+
+#define	HASH_LOG COMPRESSIONLEVEL
+#define	HASHTABLESIZE (1 << HASH_LOG)
+#define	HASH_MASK (HASHTABLESIZE - 1)
+
+#define	SKIPSTRENGTH (NOTCOMPRESSIBLE_CONFIRMATION > 2 ? \
+	NOTCOMPRESSIBLE_CONFIRMATION : 2)
+
+/*
+ * Defines if memory is allocated into the stack (local variable),
+ * or into the heap (kmem_alloc()).
+ */
+#define	HEAPMODE (HASH_LOG > STACKLIMIT)
+#define	COPYLENGTH 8
+#define	LASTLITERALS 5
+#define	MFLIMIT (COPYLENGTH + MINMATCH)
+#define	MINLENGTH (MFLIMIT + 1)
+
+#define	MAXD_LOG 16
+#define	MAX_DISTANCE ((1 << MAXD_LOG) - 1)
+
+#define	ML_BITS 4
+#define	ML_MASK ((1U<<ML_BITS)-1)
+#define	RUN_BITS (8-ML_BITS)
+#define	RUN_MASK ((1U<<RUN_BITS)-1)
+
+
+/*
+ * Architecture-specific macros
+ */
+#if LZ4_ARCH64
+#define	STEPSIZE 8
+#define	UARCH U64
+#define	AARCH A64
+#define	LZ4_COPYSTEP(s, d)	A64(d) = A64(s); d += 8; s += 8;
+#define	LZ4_COPYPACKET(s, d)	LZ4_COPYSTEP(s, d)
+#define	LZ4_SECURECOPY(s, d, e)	if (d < e) LZ4_WILDCOPY(s, d, e)
+#define	HTYPE U32
+#define	INITBASE(base)		const BYTE* const base = ip
+#else /* !LZ4_ARCH64 */
+#define	STEPSIZE 4
+#define	UARCH U32
+#define	AARCH A32
+#define	LZ4_COPYSTEP(s, d)	A32(d) = A32(s); d += 4; s += 4;
+#define	LZ4_COPYPACKET(s, d)	LZ4_COPYSTEP(s, d); LZ4_COPYSTEP(s, d);
+#define	LZ4_SECURECOPY		LZ4_WILDCOPY
+#define	HTYPE const BYTE *
+#define	INITBASE(base)		const int base = 0
+#endif /* !LZ4_ARCH64 */
+
+#if (defined(LZ4_BIG_ENDIAN) && !defined(BIG_ENDIAN_NATIVE_BUT_INCOMPATIBLE))
+#define	LZ4_READ_LITTLEENDIAN_16(d, s, p) \
+	{ U16 v = A16(p); v = lz4_bswap16(v); d = (s) - v; }
+#define	LZ4_WRITE_LITTLEENDIAN_16(p, i) \
+	{ U16 v = (U16)(i); v = lz4_bswap16(v); A16(p) = v; p += 2; }
+#else
+#define	LZ4_READ_LITTLEENDIAN_16(d, s, p) { d = (s) - A16(p); }
+#define	LZ4_WRITE_LITTLEENDIAN_16(p, v)  { A16(p) = v; p += 2; }
+#endif
+
+
+/* Local structures */
+struct refTables {
+	HTYPE hashTable[HASHTABLESIZE];
+};
+
+
+/* Macros */
+#define	LZ4_HASH_FUNCTION(i) (((i) * 2654435761U) >> ((MINMATCH * 8) - \
+	HASH_LOG))
+#define	LZ4_HASH_VALUE(p) LZ4_HASH_FUNCTION(A32(p))
+#define	LZ4_WILDCOPY(s, d, e) do { LZ4_COPYPACKET(s, d) } while (d < e);
+#define	LZ4_BLINDCOPY(s, d, l) { BYTE* e = (d) + l; LZ4_WILDCOPY(s, d, e); \
+	d = e; }
+
+
+/* Private functions */
+#if LZ4_ARCH64
+
+static int
+LZ4_NbCommonBytes(register U64 val)
+{
+#if defined(LZ4_BIG_ENDIAN)
+#if defined(_MSC_VER) && !defined(LZ4_FORCE_SW_BITCOUNT)
+	unsigned long r = 0;
+	_BitScanReverse64(&r, val);
+	return (int)(r >> 3);
+#elif defined(__GNUC__) && (GCC_VERSION >= 304) && \
+	!defined(LZ4_FORCE_SW_BITCOUNT)
+	return (__builtin_clzll(val) >> 3);
+#else
+	int r;
+	if (!(val >> 32)) {
+		r = 4;
+	} else {
+		r = 0;
+		val >>= 32;
+	}
+	if (!(val >> 16)) {
+		r += 2;
+		val >>= 8;
+	} else {
+		val >>= 24;
+	}
+	r += (!val);
+	return (r);
+#endif
+#else
+#if defined(_MSC_VER) && !defined(LZ4_FORCE_SW_BITCOUNT)
+	unsigned long r = 0;
+	_BitScanForward64(&r, val);
+	return (int)(r >> 3);
+#elif defined(__GNUC__) && (GCC_VERSION >= 304) && \
+	!defined(LZ4_FORCE_SW_BITCOUNT)
+	return (__builtin_ctzll(val) >> 3);
+#else
+	static const int DeBruijnBytePos[64] =
+	    { 0, 0, 0, 0, 0, 1, 1, 2, 0, 3, 1, 3, 1, 4, 2, 7, 0, 2, 3, 6, 1, 5,
+		3, 5, 1, 3, 4, 4, 2, 5, 6, 7, 7, 0, 1, 2, 3, 3, 4, 6, 2, 6, 5,
+		5, 3, 4, 5, 6, 7, 1, 2, 4, 6, 4,
+		4, 5, 7, 2, 6, 5, 7, 6, 7, 7
+	};
+	return DeBruijnBytePos[((U64) ((val & -val) * 0x0218A392CDABBD3F)) >>
+	    58];
+#endif
+#endif
+}
+
+#else
+
+static int
+LZ4_NbCommonBytes(register U32 val)
+{
+#if defined(LZ4_BIG_ENDIAN)
+#if defined(_MSC_VER) && !defined(LZ4_FORCE_SW_BITCOUNT)
+	unsigned long r = 0;
+	_BitScanReverse(&r, val);
+	return (int)(r >> 3);
+#elif defined(__GNUC__) && (GCC_VERSION >= 304) && \
+	!defined(LZ4_FORCE_SW_BITCOUNT)
+	return (__builtin_clz(val) >> 3);
+#else
+	int r;
+	if (!(val >> 16)) {
+		r = 2;
+		val >>= 8;
+	} else {
+		r = 0;
+		val >>= 24;
+	}
+	r += (!val);
+	return (r);
+#endif
+#else
+#if defined(_MSC_VER) && !defined(LZ4_FORCE_SW_BITCOUNT)
+	unsigned long r = 0;
+	_BitScanForward(&r, val);
+	return (int)(r >> 3);
+#elif defined(__GNUC__) && (GCC_VERSION >= 304) && \
+	!defined(LZ4_FORCE_SW_BITCOUNT)
+	return (__builtin_ctz(val) >> 3);
+#else
+	static const int DeBruijnBytePos[32] = {
+		0, 0, 3, 0, 3, 1, 3, 0,
+		3, 2, 2, 1, 3, 2, 0, 1,
+		3, 3, 1, 2, 2, 2, 2, 0,
+		3, 1, 2, 0, 1, 0, 1, 1
+	};
+	return DeBruijnBytePos[((U32) ((val & -(S32) val) * 0x077CB531U)) >>
+	    27];
+#endif
+#endif
+}
+
+#endif
+
+/* Public functions */
+
+/* Compression functions */
+
+/*ARGSUSED*/
+static int
+LZ4_compressCtx(void *ctx, const char *source, char *dest, int isize,
+    int osize)
+{
+#if HEAPMODE
+	struct refTables *srt = (struct refTables *)ctx;
+	HTYPE *HashTable = (HTYPE *) (srt->hashTable);
+#else
+	HTYPE HashTable[HASHTABLESIZE] = { 0 };
+#endif
+
+	const BYTE *ip = (BYTE *) source;
+	INITBASE(base);
+	const BYTE *anchor = ip;
+	const BYTE *const iend = ip + isize;
+	const BYTE *const oend = (BYTE *) dest + osize;
+	const BYTE *const mflimit = iend - MFLIMIT;
+#define	matchlimit (iend - LASTLITERALS)
+
+	BYTE *op = (BYTE *) dest;
+
+	int len, length;
+	const int skipStrength = SKIPSTRENGTH;
+	U32 forwardH;
+
+
+	/* Init */
+	if (isize < MINLENGTH)
+		goto _last_literals;
+
+	/* First Byte */
+	HashTable[LZ4_HASH_VALUE(ip)] = ip - base;
+	ip++;
+	forwardH = LZ4_HASH_VALUE(ip);
+
+	/* Main Loop */
+	for (;;) {
+		int findMatchAttempts = (1U << skipStrength) + 3;
+		const BYTE *forwardIp = ip;
+		const BYTE *ref;
+		BYTE *token;
+
+		/* Find a match */
+		do {
+			U32 h = forwardH;
+			int step = findMatchAttempts++ >> skipStrength;
+			ip = forwardIp;
+			forwardIp = ip + step;
+
+			if unlikely(forwardIp > mflimit) {
+				goto _last_literals;
+			}
+
+			forwardH = LZ4_HASH_VALUE(forwardIp);
+			ref = base + HashTable[h];
+			HashTable[h] = ip - base;
+
+		} while ((ref < ip - MAX_DISTANCE) || (A32(ref) != A32(ip)));
+
+		/* Catch up */
+		while ((ip > anchor) && (ref > (BYTE *) source) &&
+		    unlikely(ip[-1] == ref[-1])) {
+			ip--;
+			ref--;
+		}
+
+		/* Encode Literal length */
+		length = ip - anchor;
+		token = op++;
+
+		/* Check output limit */
+		if unlikely(op + length + (2 + 1 + LASTLITERALS) +
+		    (length >> 8) > oend)
+			return (0);
+
+		if (length >= (int)RUN_MASK) {
+			*token = (RUN_MASK << ML_BITS);
+			len = length - RUN_MASK;
+			for (; len > 254; len -= 255)
+				*op++ = 255;
+			*op++ = (BYTE)len;
+		} else
+			*token = (length << ML_BITS);
+
+		/* Copy Literals */
+		LZ4_BLINDCOPY(anchor, op, length);
+
+		_next_match:
+		/* Encode Offset */
+		LZ4_WRITE_LITTLEENDIAN_16(op, ip - ref);
+
+		/* Start Counting */
+		ip += MINMATCH;
+		ref += MINMATCH;	/* MinMatch verified */
+		anchor = ip;
+		while likely(ip < matchlimit - (STEPSIZE - 1)) {
+			UARCH diff = AARCH(ref) ^ AARCH(ip);
+			if (!diff) {
+				ip += STEPSIZE;
+				ref += STEPSIZE;
+				continue;
+			}
+			ip += LZ4_NbCommonBytes(diff);
+			goto _endCount;
+		}
+#if LZ4_ARCH64
+		if ((ip < (matchlimit - 3)) && (A32(ref) == A32(ip))) {
+			ip += 4;
+			ref += 4;
+		}
+#endif
+		if ((ip < (matchlimit - 1)) && (A16(ref) == A16(ip))) {
+			ip += 2;
+			ref += 2;
+		}
+		if ((ip < matchlimit) && (*ref == *ip))
+			ip++;
+		_endCount:
+
+		/* Encode MatchLength */
+		len = (ip - anchor);
+		/* Check output limit */
+		if unlikely(op + (1 + LASTLITERALS) + (len >> 8) > oend)
+			return (0);
+		if (len >= (int)ML_MASK) {
+			*token += ML_MASK;
+			len -= ML_MASK;
+			for (; len > 509; len -= 510) {
+				*op++ = 255;
+				*op++ = 255;
+			}
+			if (len > 254) {
+				len -= 255;
+				*op++ = 255;
+			}
+			*op++ = (BYTE)len;
+		} else
+			*token += len;
+
+		/* Test end of chunk */
+		if (ip > mflimit) {
+			anchor = ip;
+			break;
+		}
+		/* Fill table */
+		HashTable[LZ4_HASH_VALUE(ip - 2)] = ip - 2 - base;
+
+		/* Test next position */
+		ref = base + HashTable[LZ4_HASH_VALUE(ip)];
+		HashTable[LZ4_HASH_VALUE(ip)] = ip - base;
+		if ((ref > ip - (MAX_DISTANCE + 1)) && (A32(ref) == A32(ip))) {
+			token = op++;
+			*token = 0;
+			goto _next_match;
+		}
+		/* Prepare next loop */
+		anchor = ip++;
+		forwardH = LZ4_HASH_VALUE(ip);
+	}
+
+	_last_literals:
+	/* Encode Last Literals */
+	{
+		int lastRun = iend - anchor;
+		if (op + lastRun + 1 + ((lastRun + 255 - RUN_MASK) / 255) >
+		    oend)
+			return (0);
+		if (lastRun >= (int)RUN_MASK) {
+			*op++ = (RUN_MASK << ML_BITS);
+			lastRun -= RUN_MASK;
+			for (; lastRun > 254; lastRun -= 255) {
+				*op++ = 255;
+			}
+			*op++ = (BYTE)lastRun;
+		} else
+			*op++ = (lastRun << ML_BITS);
+		(void) memcpy(op, anchor, iend - anchor);
+		op += iend - anchor;
+	}
+
+	/* End */
+	return (int)(((char *)op) - dest);
+}
+
+
+
+/* Note : this function is valid only if isize < LZ4_64KLIMIT */
+#define	LZ4_64KLIMIT ((1 << 16) + (MFLIMIT - 1))
+#define	HASHLOG64K (HASH_LOG + 1)
+#define	HASH64KTABLESIZE (1U << HASHLOG64K)
+#define	LZ4_HASH64K_FUNCTION(i)	(((i) * 2654435761U) >> ((MINMATCH*8) - \
+	HASHLOG64K))
+#define	LZ4_HASH64K_VALUE(p)	LZ4_HASH64K_FUNCTION(A32(p))
+
+/*ARGSUSED*/
+static int
+LZ4_compress64kCtx(void *ctx, const char *source, char *dest, int isize,
+    int osize)
+{
+#if HEAPMODE
+	struct refTables *srt = (struct refTables *)ctx;
+	U16 *HashTable = (U16 *) (srt->hashTable);
+#else
+	U16 HashTable[HASH64KTABLESIZE] = { 0 };
+#endif
+
+	const BYTE *ip = (BYTE *) source;
+	const BYTE *anchor = ip;
+	const BYTE *const base = ip;
+	const BYTE *const iend = ip + isize;
+	const BYTE *const oend = (BYTE *) dest + osize;
+	const BYTE *const mflimit = iend - MFLIMIT;
+#define	matchlimit (iend - LASTLITERALS)
+
+	BYTE *op = (BYTE *) dest;
+
+	int len, length;
+	const int skipStrength = SKIPSTRENGTH;
+	U32 forwardH;
+
+	/* Init */
+	if (isize < MINLENGTH)
+		goto _last_literals;
+
+	/* First Byte */
+	ip++;
+	forwardH = LZ4_HASH64K_VALUE(ip);
+
+	/* Main Loop */
+	for (;;) {
+		int findMatchAttempts = (1U << skipStrength) + 3;
+		const BYTE *forwardIp = ip;
+		const BYTE *ref;
+		BYTE *token;
+
+		/* Find a match */
+		do {
+			U32 h = forwardH;
+			int step = findMatchAttempts++ >> skipStrength;
+			ip = forwardIp;
+			forwardIp = ip + step;
+
+			if (forwardIp > mflimit) {
+				goto _last_literals;
+			}
+
+			forwardH = LZ4_HASH64K_VALUE(forwardIp);
+			ref = base + HashTable[h];
+			HashTable[h] = ip - base;
+
+		} while (A32(ref) != A32(ip));
+
+		/* Catch up */
+		while ((ip > anchor) && (ref > (BYTE *) source) &&
+		    (ip[-1] == ref[-1])) {
+			ip--;
+			ref--;
+		}
+
+		/* Encode Literal length */
+		length = ip - anchor;
+		token = op++;
+
+		/* Check output limit */
+		if unlikely(op + length + (2 + 1 + LASTLITERALS) +
+		    (length >> 8) > oend)
+			return (0);
+
+		if (length >= (int)RUN_MASK) {
+			*token = (RUN_MASK << ML_BITS);
+			len = length - RUN_MASK;
+			for (; len > 254; len -= 255)
+				*op++ = 255;
+			*op++ = (BYTE)len;
+		} else
+			*token = (length << ML_BITS);
+
+		/* Copy Literals */
+		LZ4_BLINDCOPY(anchor, op, length);
+
+		_next_match:
+		/* Encode Offset */
+		LZ4_WRITE_LITTLEENDIAN_16(op, ip - ref);
+
+		/* Start Counting */
+		ip += MINMATCH;
+		ref += MINMATCH;	/* MinMatch verified */
+		anchor = ip;
+		while (ip < matchlimit - (STEPSIZE - 1)) {
+			UARCH diff = AARCH(ref) ^ AARCH(ip);
+			if (!diff) {
+				ip += STEPSIZE;
+				ref += STEPSIZE;
+				continue;
+			}
+			ip += LZ4_NbCommonBytes(diff);
+			goto _endCount;
+		}
+#if LZ4_ARCH64
+		if ((ip < (matchlimit - 3)) && (A32(ref) == A32(ip))) {
+			ip += 4;
+			ref += 4;
+		}
+#endif
+		if ((ip < (matchlimit - 1)) && (A16(ref) == A16(ip))) {
+			ip += 2;
+			ref += 2;
+		}
+		if ((ip < matchlimit) && (*ref == *ip))
+			ip++;
+		_endCount:
+
+		/* Encode MatchLength */
+		len = (ip - anchor);
+		/* Check output limit */
+		if unlikely(op + (1 + LASTLITERALS) + (len >> 8) > oend)
+			return (0);
+		if (len >= (int)ML_MASK) {
+			*token += ML_MASK;
+			len -= ML_MASK;
+			for (; len > 509; len -= 510) {
+				*op++ = 255;
+				*op++ = 255;
+			}
+			if (len > 254) {
+				len -= 255;
+				*op++ = 255;
+			}
+			*op++ = (BYTE)len;
+		} else
+			*token += len;
+
+		/* Test end of chunk */
+		if (ip > mflimit) {
+			anchor = ip;
+			break;
+		}
+		/* Fill table */
+		HashTable[LZ4_HASH64K_VALUE(ip - 2)] = ip - 2 - base;
+
+		/* Test next position */
+		ref = base + HashTable[LZ4_HASH64K_VALUE(ip)];
+		HashTable[LZ4_HASH64K_VALUE(ip)] = ip - base;
+		if (A32(ref) == A32(ip)) {
+			token = op++;
+			*token = 0;
+			goto _next_match;
+		}
+		/* Prepare next loop */
+		anchor = ip++;
+		forwardH = LZ4_HASH64K_VALUE(ip);
+	}
+
+	_last_literals:
+	/* Encode Last Literals */
+	{
+		int lastRun = iend - anchor;
+		if (op + lastRun + 1 + ((lastRun + 255 - RUN_MASK) / 255) >
+		    oend)
+			return (0);
+		if (lastRun >= (int)RUN_MASK) {
+			*op++ = (RUN_MASK << ML_BITS);
+			lastRun -= RUN_MASK;
+			for (; lastRun > 254; lastRun -= 255)
+				*op++ = 255;
+			*op++ = (BYTE)lastRun;
+		} else
+			*op++ = (lastRun << ML_BITS);
+		(void) memcpy(op, anchor, iend - anchor);
+		op += iend - anchor;
+	}
+
+	/* End */
+	return (int)(((char *)op) - dest);
+}
+
+static int
+real_LZ4_compress(const char *source, char *dest, int isize, int osize)
+{
+#if HEAPMODE
+	void *ctx = umem_zalloc(sizeof (struct refTables), UMEM_DEFAULT);
+	int result;
+
+	/*
+	 * out of kernel memory, gently fall through - this will disable
+	 * compression in zio_compress_data
+	 */
+	if (ctx == NULL)
+		return (0);
+
+	if (isize < LZ4_64KLIMIT)
+		result = LZ4_compress64kCtx(ctx, source, dest, isize, osize);
+	else
+		result = LZ4_compressCtx(ctx, source, dest, isize, osize);
+
+	umem_free(ctx, sizeof (struct refTables));
+	return (result);
+#else
+	if (isize < (int)LZ4_64KLIMIT)
+		return (LZ4_compress64kCtx(NULL, source, dest, isize, osize));
+	return (LZ4_compressCtx(NULL, source, dest, isize, osize));
+#endif
+}
+
+/* Decompression functions */
+
+/*
+ * Note: The decoding function LZ4_uncompress_unknownOutputSize() is safe
+ *	against "buffer overflow" attack type.
+ *	LZ4_uncompress_unknownOutputSize() insures that it will never read
+ *	outside of the input buffer. A corrupted input will produce an error
+ *	result, a negative int, indicating the position of the error within
+ *	input stream.
+ */
+
+static int
+LZ4_uncompress_unknownOutputSize(const char *source, char *dest, int isize,
+    int maxOutputSize)
+{
+	/* Local Variables */
+	const BYTE *restrict ip = (const BYTE *) source;
+	const BYTE *const iend = ip + isize;
+	const BYTE *ref;
+
+	BYTE *op = (BYTE *) dest;
+	BYTE *const oend = op + maxOutputSize;
+	BYTE *cpy;
+
+	size_t dec32table[] = {0, 3, 2, 3, 0, 0, 0, 0};
+#if LZ4_ARCH64
+	size_t dec64table[] = {0, 0, 0, (size_t)-1, 0, 1, 2, 3};
+#endif
+
+	/* Main Loop */
+	while (ip < iend) {
+		unsigned token;
+		size_t length;
+
+		/* get runlength */
+		token = *ip++;
+		if ((length = (token >> ML_BITS)) == RUN_MASK) {
+			int s = 255;
+			while ((ip < iend) && (s == 255)) {
+				s = *ip++;
+				length += s;
+			}
+		}
+		/* copy literals */
+		cpy = op + length;
+		/* CORNER-CASE: cpy might overflow. */
+		if (cpy < op)
+			goto _output_error;	/* cpy was overflowed, bail! */
+		if ((cpy > oend - COPYLENGTH) ||
+		    (ip + length > iend - COPYLENGTH)) {
+			if (cpy > oend)
+				/* Error: writes beyond output buffer */
+				goto _output_error;
+			if (ip + length != iend)
+				/*
+				 * Error: LZ4 format requires to consume all
+				 * input at this stage
+				 */
+				goto _output_error;
+			(void) memcpy(op, ip, length);
+			op += length;
+			/* Necessarily EOF, due to parsing restrictions */
+			break;
+		}
+		LZ4_WILDCOPY(ip, op, cpy);
+		ip -= (op - cpy);
+		op = cpy;
+
+		/* get offset */
+		LZ4_READ_LITTLEENDIAN_16(ref, cpy, ip);
+		ip += 2;
+		if (ref < (BYTE * const) dest)
+			/*
+			 * Error: offset creates reference outside of
+			 * destination buffer
+			 */
+			goto _output_error;
+
+		/* get matchlength */
+		if ((length = (token & ML_MASK)) == ML_MASK) {
+			while (ip < iend) {
+				int s = *ip++;
+				length += s;
+				if (s == 255)
+					continue;
+				break;
+			}
+		}
+		/* copy repeated sequence */
+		if unlikely(op - ref < STEPSIZE) {
+#if LZ4_ARCH64
+			size_t dec64 = dec64table[op-ref];
+#else
+			const int dec64 = 0;
+#endif
+			op[0] = ref[0];
+			op[1] = ref[1];
+			op[2] = ref[2];
+			op[3] = ref[3];
+			op += 4;
+			ref += 4;
+			ref -= dec32table[op-ref];
+			A32(op) = A32(ref);
+			op += STEPSIZE - 4;
+			ref -= dec64;
+		} else {
+			LZ4_COPYSTEP(ref, op);
+		}
+		cpy = op + length - (STEPSIZE - 4);
+		if (cpy > oend - COPYLENGTH) {
+			if (cpy > oend)
+				/*
+				 * Error: request to write outside of
+				 * destination buffer
+				 */
+				goto _output_error;
+			LZ4_SECURECOPY(ref, op, (oend - COPYLENGTH));
+			while (op < cpy)
+				*op++ = *ref++;
+			op = cpy;
+			if (op == oend)
+				/*
+				 * Check EOF (should never happen, since
+				 * last 5 bytes are supposed to be literals)
+				 */
+				goto _output_error;
+			continue;
+		}
+		LZ4_SECURECOPY(ref, op, cpy);
+		op = cpy;	/* correction */
+	}
+
+	/* end of decoding */
+	return (int)(((char *)op) - dest);
+
+	/* write overflow error detected */
+	_output_error:
+	return (int)(-(((char *)ip) - source));
+}
diff --git a/usr/src/common/ficl/softcore/makesoftcore.c b/usr/src/common/ficl/softcore/makesoftcore.c
new file mode 100644
index 0000000000..d24006261c
--- /dev/null
+++ b/usr/src/common/ficl/softcore/makesoftcore.c
@@ -0,0 +1,249 @@
+/*
+ * Ficl softcore generator.
+ * Generates both uncompressed and Lempel-Ziv compressed versions.
+ * Strips blank lines, strips full-line comments, collapses whitespace.
+ * Chops, blends, dices, makes julienne fries.
+ *
+ * Contributed by Larry Hastings, larry@hastings.org
+ */
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+#include "ficl.h"
+
+#ifndef SOFTCORE_OUT
+#define	SOFTCORE_OUT	"softcore.c"
+#endif
+
+extern size_t
+lz4_compress(void *s_start, void *d_start, size_t s_len, size_t d_len, int n);
+
+void
+fprintDataAsHex(FILE *f, unsigned char *data, int length)
+{
+	int i;
+	while (length) {
+		fprintf(f, "\t");
+		for (i = 0; (i < 8) && length; i++) {
+			char buf[16];
+			/*
+			 * if you don't do this little stuff, you get ugly
+			 * sign-extended 0xFFFFFF6b crap.
+			 */
+			sprintf(buf, "%08x", (unsigned int)*data++);
+			fprintf(f, "0x%s, ", buf + 6);
+			length--;
+		}
+		fprintf(f, "\n");
+	}
+}
+
+void
+fprintDataAsQuotedString(FILE *f, char *data)
+{
+	int lineIsBlank = 1; /* true */
+
+	while (*data) {
+		if (*data == '\n') {
+			if (!lineIsBlank)
+				fprintf(f, "\\n\"\n");
+			lineIsBlank = 1; /* true */
+		} else {
+			if (lineIsBlank) {
+				fputc('\t', f);
+				fputc('"', f);
+				lineIsBlank = 0; /* false */
+			}
+
+			if (*data == '"')
+				fprintf(f, "\\\"");
+			else if (*data == '\\')
+				fprintf(f, "\\\\");
+			else
+				fputc(*data, f);
+		}
+		data++;
+	}
+	if (!lineIsBlank)
+		fprintf(f, "\"");
+}
+
+int
+main(int argc, char *argv[])
+{
+	char *uncompressed = (char *)malloc(128 * 1024);
+	unsigned char *compressed = malloc(128 * 1024);
+	char *trace = uncompressed;
+	int i;
+	size_t compressedSize = 128 * 1024;
+	size_t uncompressedSize;
+	char *src, *dst;
+	FILE *f;
+	time_t currentTimeT;
+	struct tm *currentTime;
+	char cleverTime[32];
+
+	time(&currentTimeT);
+	currentTime = localtime(&currentTimeT);
+	strftime(cleverTime, sizeof (cleverTime),
+	    "%Y/%m/%d %H:%M:%S", currentTime);
+
+	*trace++ = ' ';
+
+	for (i = 1; i < argc; i++) {
+		int size;
+		/*
+		 * This ensures there's always whitespace space between files.
+		 * It *also* ensures that src[-1] is always safe in comment
+		 * detection code below.  (Any leading whitespace will be
+		 * thrown away in a later pass.)
+		 * --lch
+		 */
+		*trace++ = ' ';
+
+		f = fopen(argv[i], "rb");
+		fseek(f, 0, SEEK_END);
+		size = ftell(f);
+		fseek(f, 0, SEEK_SET);
+		fread(trace, 1, size, f);
+		fclose(f);
+		trace += size;
+	}
+	*trace = 0;
+
+#define	IS_EOL(x)	((*x == '\n') || (*x == '\r'))
+#define	IS_EOL_COMMENT(x)	\
+	(((x[0] == '\\') && isspace(x[1])) || \
+	((x[0] == '/') && (x[1] == '/') && isspace(x[2])))
+#define	IS_BLOCK_COMMENT(x)	\
+	((x[0] == '(') && isspace(x[1]) && isspace(x[-1]))
+
+	src = dst = uncompressed;
+	while (*src) {
+		/* ignore leading whitespace, or entirely blank lines */
+		while (isspace(*src))
+			src++;
+		/* if the line is commented out */
+		if (IS_EOL_COMMENT(src)) {
+			/* throw away this entire line */
+			while (*src && !IS_EOL(src))
+				src++;
+			continue;
+		}
+		/*
+		 * This is where we'd throw away mid-line comments, but
+		 * that's simply unsafe.  Things like
+		 *	start-prefixes
+		 *	: \ postpone \ ;
+		 *	: ( postpone ( ;
+		 * get broken that way.
+		 * --lch
+		 */
+		while (*src && !IS_EOL(src)) {
+			*dst++ = *src++;
+		}
+
+		/* strip trailing whitespace */
+		dst--;
+		while (isspace(*dst))
+			dst--;
+		dst++;
+
+		/* and end the line */
+		*dst++ = '\n';
+	}
+
+	*dst = 0;
+
+	/*
+	 * now make a second pass to collapse all contiguous whitespace
+	 * to a single space.
+	 */
+	src = dst = uncompressed;
+	while (*src) {
+		*dst++ = *src;
+		if (!isspace(*src))
+			src++;
+		else {
+			while (isspace(*src))
+				src++;
+		}
+	}
+	*dst = 0;
+
+	f = fopen(SOFTCORE_OUT, "wt");
+	if (f == NULL) {
+		printf("couldn't open " SOFTCORE_OUT
+		    " for writing!  giving up.\n");
+		exit(-1);
+	}
+
+	fprintf(f,
+"/*\n"
+"** Ficl softcore\n"
+"** both uncompressed and LZ4 compressed versions.\n"
+"**\n"
+"** Generated %s\n"
+"**/\n"
+"\n"
+"#include \"ficl.h\"\n"
+"\n"
+"\n", cleverTime);
+
+	uncompressedSize = dst - uncompressed;
+	compressedSize = lz4_compress(uncompressed, compressed,
+	    uncompressedSize, compressedSize, 0);
+
+	fprintf(f, "static size_t ficlSoftcoreUncompressedSize = %d; "
+	    "/* not including trailing null */\n", uncompressedSize);
+	fprintf(f, "\n");
+	fprintf(f, "#if !FICL_WANT_LZ4_SOFTCORE\n");
+	fprintf(f, "\n");
+	fprintf(f, "static char ficlSoftcoreUncompressed[] =\n");
+	fprintDataAsQuotedString(f, uncompressed);
+	fprintf(f, ";\n");
+	fprintf(f, "\n");
+	fprintf(f, "#else /* !FICL_WANT_LZ4_SOFTCORE */\n");
+	fprintf(f, "\n");
+	fprintf(f, "extern int lz4_decompress(void *, void *, size_t, "
+	    "size_t, int);\n\n");
+	fprintf(f, "static unsigned char ficlSoftcoreCompressed[%d] = "
+	    "{\n", compressedSize);
+	fprintDataAsHex(f, compressed, compressedSize);
+	fprintf(f, "\t};\n");
+	fprintf(f, "\n");
+	fprintf(f, "#endif /* !FICL_WANT_LZ4_SOFTCORE */\n");
+	fprintf(f,
+"\n"
+"\n"
+"void ficlSystemCompileSoftCore(ficlSystem *system)\n"
+"{\n"
+"    ficlVm *vm = system->vmList;\n"
+"    int returnValue;\n"
+"    ficlCell oldSourceID = vm->sourceId;\n"
+"    ficlString s;\n"
+"#if FICL_WANT_LZ4_SOFTCORE\n"
+"    char *ficlSoftcoreUncompressed = malloc(ficlSoftcoreUncompressedSize+1);\n"
+"    returnValue = lz4_decompress(ficlSoftcoreCompressed, "
+"ficlSoftcoreUncompressed, sizeof(ficlSoftcoreCompressed), "
+"ficlSoftcoreUncompressedSize+1, 0);\n"
+"    FICL_VM_ASSERT(vm, returnValue == 0);\n"
+"#endif /* FICL_WANT_LZ4_SOFTCORE */\n"
+"    vm->sourceId.i = -1;\n"
+"    FICL_STRING_SET_POINTER(s, (char *)(ficlSoftcoreUncompressed));\n"
+"    FICL_STRING_SET_LENGTH(s, ficlSoftcoreUncompressedSize);\n"
+"    returnValue = ficlVmExecuteString(vm, s);\n"
+"    vm->sourceId = oldSourceID;\n"
+"#if FICL_WANT_LZ4_SOFTCORE\n"
+"    free(ficlSoftcoreUncompressed);\n"
+"#endif /* FICL_WANT_LZ4_SOFTCORE */\n"
+"    FICL_VM_ASSERT(vm, returnValue != FICL_VM_STATUS_ERROR_EXIT);\n"
+"    return;\n"
+"}\n\n"
+"/* end-of-file */\n");
+	free(uncompressed);
+	free(compressed);
+	return (0);
+}
diff --git a/usr/src/common/ficl/softcore/marker.fr b/usr/src/common/ficl/softcore/marker.fr
new file mode 100644
index 0000000000..92848bdd1f
--- /dev/null
+++ b/usr/src/common/ficl/softcore/marker.fr
@@ -0,0 +1,25 @@
+\ ** ficl/softwords/marker.fr
+\ ** Ficl implementation of CORE EXT MARKER
+\ John Sadler, 4 Oct 98
+\ Requires ficl 2.02 FORGET-WID !!
+.( loading MARKER ) cr
+: marker   ( "name" -- )
+    create
+    get-current ,
+    get-order dup ,
+    0 ?do , loop
+  does>
+    0 set-order                     \ clear search order
+    dup body> >name drop
+    here - allot                    \ reset HERE to my xt-addr
+    dup @                           ( pfa current-wid )
+    dup set-current forget-wid      ( pfa )
+    cell+ dup @ swap                ( count count-addr )
+    over cells + swap               ( last-wid-addr count )
+    0 ?do
+        dup @ dup                   ( wid-addr wid wid )
+        >search forget-wid          ( wid-addr )
+        cell-
+    loop
+    drop
+;
diff --git a/usr/src/common/ficl/softcore/oo.fr b/usr/src/common/ficl/softcore/oo.fr
new file mode 100644
index 0000000000..ac61a48756
--- /dev/null
+++ b/usr/src/common/ficl/softcore/oo.fr
@@ -0,0 +1,700 @@
+S" FICL_WANT_OOP" ENVIRONMENT? drop [if]
+\ ** ficl/softwords/oo.fr
+\ ** F I C L   O - O   E X T E N S I O N S
+\ ** john sadler aug 1998
+
+.( loading ficl O-O extensions ) cr
+17 ficl-vocabulary oop
+also oop definitions
+
+\ Design goals:
+\ 0. Traditional OOP: late binding by default for safety.
+\    Early binding if you ask for it.
+\ 1. Single inheritance
+\ 2. Object aggregation (has-a relationship)
+\ 3. Support objects in the dictionary and as proxies for
+\    existing structures (by reference):
+\    *** A ficl object can wrap a C struct ***
+\ 4. Separate name-spaces for methods - methods are
+\    only visible in the context of a class / object
+\ 5. Methods can be overridden, and subclasses can add methods.
+\    No limit on number of methods.
+
+\ General info:
+\ Classes are objects, too: all classes are instances of METACLASS
+\ All classes are derived (by convention) from OBJECT. This
+\ base class provides a default initializer and superclass
+\ access method
+
+\ A ficl object binds instance storage (payload) to a class.
+\ object  ( -- instance class )
+\ All objects push their payload address and class address when
+\ executed.
+
+\ A ficl class consists of a parent class pointer, a wordlist
+\ ID for the methods of the class, and a size for the payload
+\ of objects created by the class. A class is an object.
+\ The NEW method creates and initializes an instance of a class.
+\ Classes have this footprint:
+\ cell 0: parent class address
+\ cell 1: wordlist ID
+\ cell 2: size of instance's payload
+
+\ Methods expect an object couple ( instance class )
+\ on the stack. 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, 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 !
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ** 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...
+\
+
+\ 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
+; compile-only
+
+
+
+: (lookup-method)  { class 2:name -- class 0 | class xt 1 | class xt -1  }
+    class  name class cell+ @  ( class c-addr u wid )
+    search-wordlist
+;
+
+\ 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 }
+    class name (lookup-method)    ( 0 | xt 1 | xt -1 )
+    0= if
+        name type ."  not found in "
+        class body> >name type
+        cr abort
+    endif
+;
+
+: find-method-xt   \ name ( class -- class xt )
+    parse-word lookup-method
+;
+
+: catch-method  ( instance class c-addr u -- <method-signature> exc-flag )
+    lookup-method catch
+;
+
+: exec-method  ( instance class c-addr u -- <method-signature> )
+    lookup-method execute
+;
+
+\ Method lookup operator takes a class-addr and instance-addr
+\ and executes the method from the class's wordlist if
+\ interpreting. If compiling, bind late.
+\
+: -->   ( instance class -- ??? )
+    state @ 0= if
+        find-method-xt execute
+    else
+        parse-method  postpone exec-method
+    endif
+; immediate
+
+\ Method lookup with CATCH in case of exceptions
+: c->   ( instance class -- ?? exc-flag )
+    state @ 0= if
+        find-method-xt catch
+    else
+        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 ;
+
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ** E A R L Y   B I N D I N G
+\ Early binding operator compiles code to execute a method
+\ given its class at compile time. Classes are immediate,
+\ so they leave their cell-pair on the stack when compiling.
+\ Example:
+\   : get-wid   metaclass => .wid @ ;
+\ Usage
+\   my-class get-wid  ( -- wid-of-my-class )
+\
+1 ficl-named-wordlist instance-vars
+instance-vars dup >search ficl-set-current
+
+: =>   \ c:( class meta -- ) run: ( -- ??? ) invokes compiled method
+    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 an 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             ( 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
+
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ** I N S T A N C E   V A R I A B L E S
+\ Instance variables (IV) are represented by words in the class's
+\ private wordlist. Each IV word contains the offset
+\ of the IV it represents, and runs code to add that offset
+\ to the base address of an instance when executed.
+\ The metaclass SUB method, defined below, leaves the address
+\ of the new class's offset field and its initial size on the
+\ stack for these words to update. When a class definition is
+\ complete, END-CLASS saves the final size in the class's size
+\ field, and restores the search order and compile wordlist to
+\ prior state. Note that these words are hidden in their own
+\ wordlist to prevent accidental use outside a SUB END-CLASS pair.
+\
+: do-instance-var
+    does>   ( instance class addr[offset] -- addr[field] )
+        nip @ +
+;
+
+: addr-units:  ( offset size "name" -- offset' )
+    create over , +
+    do-instance-var
+;
+
+: chars:    \ ( offset nCells "name" -- offset' ) Create n char member.
+   chars addr-units: ;
+
+: char:     \ ( offset nCells "name" -- offset' ) Create 1 char member.
+   1 chars: ;
+
+: cells:  ( offset nCells "name" -- offset' )
+    cells >r aligned r> addr-units:
+;
+
+: cell:   ( offset nCells "name" -- offset' )
+    1 cells: ;
+
+\ Aggregate an object into the class...
+\ Needs the class of the instance to create
+\ Example: object obj: m_obj
+\
+: do-aggregate
+    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 -- offset' }  \ "name"
+    create  offset , class ,
+    class meta --> get-size  offset +
+    do-aggregate
+;
+
+\ Aggregate an array of objects into a class
+\ Usage example:
+\ 3 my-class array: my-array
+\ Makes an instance variable array of 3 instances of my-class
+\ named my-array.
+\
+: array:   ( offset n class meta "name" -- offset' )
+    locals| meta class nobjs offset |
+    create offset , class ,
+    class meta --> get-size  nobjs * offset +
+    do-aggregate
+;
+
+\ Aggregate a pointer to an object: REF is a member variable
+\ whose class is set at compile time. This is useful for wrapping
+\ data structures in C, where there is only a pointer and the type
+\ it refers to is known. If you want polymorphism, see c_ref
+\ in classes.fr. REF is only useful for pre-initialized structures,
+\ since there's no supported way to set one.
+: ref:   ( offset class meta "name" -- offset' )
+    locals| meta class offset |
+    create offset , class ,
+    offset cell+
+    does>    ( inst class pfa -- ptr-inst ptr-class )
+    2@       ( inst class ptr-class ptr-offset )
+    2swap drop + @ swap
+;
+
+S" FICL_WANT_VCALL" ENVIRONMENT? drop [if]
+\ 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.
+
+S" FICL_WANT_FLOAT" ENVIRONMENT? drop [if]
+: 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] \ FICL_WANT_FLOAT
+[endif] \ FICL_WANT_VCALL
+
+\ END-CLASS terminates construction of a class by storing
+\  the size of its instance variables in the class's size field
+\ ( -- old-wid addr[size] 0 )
+\
+: end-class  ( old-wid addr[size] size -- )
+    swap ! set-current
+    search> drop        \ pop struct builder wordlist
+;
+
+\ See resume-class (a metaclass method) below for usage
+\ This is equivalent to end-class for now, but that will change
+\ when we support vtable bindings.
+: suspend-class  ( old-wid addr[size] size -- )   end-class ;
+
+set-current previous
+\ E N D   I N S T A N C E   V A R I A B L E S
+
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ D O - D O - I N S T A N C E
+\ Makes a class method that contains the code for an
+\ instance of the class. This word gets compiled into
+\ the wordlist of every class by the SUB method.
+\ PRECONDITION: current-class contains the class address
+\ why use a state variable instead of the stack?
+\ >> 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
+\
+: do-do-instance  ( -- )
+    s" : .do-instance does> [ current-class @ ] literal ;"
+    evaluate
+;
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ** M E T A C L A S S
+\ Every class is an instance of metaclass. This lets
+\ classes have methods that are different from those
+\ of their instances.
+\ Classes are IMMEDIATE to make early binding simpler
+\ See above...
+\
+:noname
+    wordlist
+    create
+    immediate
+    0       ,   \ NULL parent class
+    dup     ,   \ wid
+[ S" FICL_WANT_VCALL" ENVIRONMENT? drop ] [if]
+    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
+
+metaclass drop current-class !
+do-do-instance
+
+\
+\ C L A S S   M E T H O D S
+\
+instance-vars >search
+
+create .super  ( class metaclass -- parent-class )
+    0 cells , do-instance-var
+
+create .wid    ( class metaclass -- wid ) \ return wid of class
+    1 cells , do-instance-var
+
+S" FICL_WANT_VCALL" ENVIRONMENT? drop [if]
+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 @ ;
+S" FICL_WANT_VCALL" ENVIRONMENT? drop [if]
+: 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
+    here parent --> .do-instance \ ( inst class )
+    parent meta metaclass => get-size
+    allot                        \ allocate payload space
+;
+
+\ create an uninitialized array
+: array   ( n class metaclass "name" -- n instance class )
+    locals| meta parent nobj |
+    create  nobj
+    here parent --> .do-instance \ ( nobj inst class )
+    parent meta metaclass => get-size
+    nobj *  allot           \ allocate payload space
+;
+
+\ create an initialized instance
+\
+: new   \ ( class metaclass "name" -- )
+    metaclass => instance --> init
+;
+
+\ create an initialized array of instances
+: new-array   ( n class metaclass "name" -- )
+    metaclass => array
+    --> array-init
+;
+
+\ Create an anonymous initialized instance from the heap
+: alloc   \ ( class metaclass -- instance class )
+    locals| meta class |
+    class meta metaclass => get-size allocate   ( -- addr fail-flag )
+    abort" allocate failed "                    ( -- addr )
+    class 2dup --> init
+;
+
+\ Create an anonymous array of initialized instances from the heap
+: alloc-array   \ ( n class metaclass -- instance class )
+    locals| meta class nobj |
+    class meta metaclass => get-size
+    nobj * allocate                 ( -- addr fail-flag )
+    abort" allocate failed "        ( -- addr )
+    nobj over class --> array-init
+    class
+;
+
+\ Create an anonymous initialized instance from the dictionary
+: allot   { 2:this -- 2:instance }
+    here   ( instance-address )
+    this my=> get-size  allot
+    this drop 2dup --> init
+;
+
+\ Create an anonymous array of initialized instances from the dictionary
+: allot-array   { nobj 2:this -- 2:instance }
+    here   ( instance-address )
+    this my=> get-size  nobj * allot
+    this drop 2dup     ( 2instance 2instance )
+    nobj -rot --> array-init
+;
+
+\ create a proxy object with initialized payload address given
+: ref   ( instance-addr class metaclass "name" -- )
+    drop create , ,
+    does> 2@
+;
+
+\ suspend-class and resume-class help to build mutually referent classes.
+\ Example:
+\ object subclass c-akbar
+\ suspend-class   ( put akbar on hold while we define jeff )
+\ object subclass c-jeff
+\     c-akbar ref: .akbar
+\     ( and whatever else comprises this class )
+\ end-class    ( done with c-jeff )
+\ c-akbar --> resume-class
+\     c-jeff ref: .jeff
+\     ( and whatever else goes in c-akbar )
+\ end-class    ( done with c-akbar )
+\
+: resume-class   { 2:this -- old-wid addr[size] size }
+    this --> .wid @ ficl-set-current  ( old-wid )
+    this --> .size dup @   ( old-wid addr[size] size )
+    instance-vars >search
+;
+
+\ create a subclass
+\ This method leaves the stack and search order ready for instance variable
+\ building. Pushes the instance-vars wordlist onto the search order,
+\ and sets the compilation wordlist to be the private wordlist of the
+\ new class. The class's wordlist is deliberately NOT in the search order -
+\ to prevent methods from getting used with wrong data.
+\ 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
+    wid brand-wordlist      \ label the subclass wordlist
+    here current-class !    \ prep for do-do-instance
+    parent ,                \ save parent class
+    wid    ,                \ save wid
+[ S" FICL_WANT_VCALL" ENVIRONMENT? drop ] [if]
+    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
+\ from the instance base address. If the next token is not
+\ the name of in instance variable method, you get garbage
+\ results -- there is no way at present to check for this error.
+: offset-of   ( class metaclass "name" -- offset )
+    drop find-method-xt nip >body @ ;
+
+\ ID returns the string name cell-pair of its class
+: id   ( class metaclass -- c-addr u )
+    drop body> >name  ;
+
+\ list methods of the class
+: methods \ ( class meta -- )
+    locals| meta class |
+    begin
+        class body> >name type ."  methods:" cr
+        class meta --> get-wid >search words cr previous
+        class meta metaclass => get-super
+        dup to class
+    0= until  cr
+;
+
+\ list class's ancestors
+: pedigree  ( class meta -- )
+    locals| meta class |
+    begin
+        class body> >name type space
+        class meta metaclass => get-super
+        dup to class
+    0= until  cr
+;
+
+\ decompile an instance method
+: see  ( class meta -- )
+    metaclass => get-wid >search see previous ;
+
+\ 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...
+metaclass drop
+constant meta
+
+\ ** SUBCLASS is a nickname for a class's SUB method...
+\ Subclass compilation ends when you invoke end-class
+\ This method is late bound for safety...
+: subclass   --> sub ;
+
+S" FICL_WANT_VCALL" ENVIRONMENT? drop [if]
+\ 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
+[ S" FICL_WANT_VCALL" ENVIRONMENT? drop ] [if]
+    0       ,   \ .vtCount
+[endif]
+    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
+
+object drop current-class !
+do-do-instance
+instance-vars >search
+
+\ O B J E C T   M E T H O D S
+\ Convert instance cell-pair to class cell-pair
+\ Useful for binding class methods from an instance
+: class  ( instance class -- class metaclass )
+    nip meta ;
+
+\ default INIT method zero fills an instance
+: init   ( instance class -- )
+    meta
+    metaclass => get-size   ( inst size )
+    erase ;
+
+\ Apply INIT to an array of NOBJ objects...
+\
+: array-init   ( nobj inst class -- )
+    0 dup locals| &init &next class inst |
+    \
+    \ bind methods outside the loop to save time
+    \
+    class s" init" lookup-method to &init
+          s" next" lookup-method to &next
+    drop
+    0 ?do
+        inst class 2dup
+        &init execute
+        &next execute  drop to inst
+    loop
+;
+
+\ 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 "
+;
+
+\ Instance aliases for common class methods
+\ Upcast to parent class
+: super     ( instance class -- instance parent-class )
+    meta  metaclass => get-super ;
+
+: pedigree  ( instance class -- )
+    object => class
+    metaclass => pedigree ;
+
+: size      ( instance class -- sizeof-instance )
+    object => class
+    metaclass => get-size ;
+
+: methods   ( instance class -- )
+    object => class
+    metaclass => methods ;
+
+\ Array indexing methods...
+\ Usage examples:
+\ 10 object-array --> index
+\ obj --> next
+\
+: index   ( n instance class -- instance[n] class )
+    locals| class inst |
+    inst class
+    object => class
+    metaclass => get-size  *   ( n*size )
+    inst +  class ;
+
+: next   ( instance[n] class -- instance[n+1] class )
+    locals| class inst |
+    inst class
+    object => class
+    metaclass => get-size
+    inst +
+    class ;
+
+: prev   ( instance[n] class -- instance[n-1] class )
+    locals| class inst |
+    inst class
+    object => class
+    metaclass => get-size
+    inst swap -
+    class ;
+
+: debug   ( 2this --  ?? )
+    find-method-xt debug-xt ;
+
+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/usr/src/common/ficl/softcore/prefix.fr b/usr/src/common/ficl/softcore/prefix.fr
new file mode 100644
index 0000000000..cbf060bbb2
--- /dev/null
+++ b/usr/src/common/ficl/softcore/prefix.fr
@@ -0,0 +1,46 @@
+\ **
+\ ** Prefix words for ficl
+\ ** submitted by Larry Hastings, larry@hastings.org
+\ **
+\ (jws) To make a prefix, simply create a new definition in the <prefixes>
+\ wordlist. start-prefixes and end-prefixes handle the bookkeeping
+
+variable save-current
+
+: start-prefixes   get-current save-current ! <prefixes> set-current ;
+: end-prefixes     save-current @ set-current ;
+: show-prefixes    <prefixes> >search  words  search> drop ;
+
+start-prefixes
+
+S" FICL_WANT_EXTENDED_PREFIX" ENVIRONMENT? drop [if]
+
+\ define " (double-quote) as an alias for s", and make it a prefix
+: " postpone s" ; immediate
+
+
+\ make .( a prefix (we just create an alias for it in the prefixes list)
+: .( postpone .( ; immediate
+
+
+\ make \ a prefix, and add // (same thing) as a prefix too
+: \ postpone \ ; immediate
+: // postpone \ ; immediate
+
+
+\ ** add 0b, 0o, 0d, and 0x as prefixes
+\ ** these temporarily shift the base to 2, 8, 10, and 16 respectively
+\ ** and consume the next number in the input stream, pushing/compiling
+\ ** as normal
+\ **
+\ ** __tempbase is precompiled, see prefix.c
+
+: 0b  2 __tempbase ; immediate
+: 0o  8 __tempbase ; immediate
+
+[endif]
+
+: 0d 10 __tempbase ; immediate
+: 0x 16 __tempbase ; immediate
+
+end-prefixes
diff --git a/usr/src/common/ficl/softcore/softcore.fr b/usr/src/common/ficl/softcore/softcore.fr
new file mode 100644
index 0000000000..3adba1f195
--- /dev/null
+++ b/usr/src/common/ficl/softcore/softcore.fr
@@ -0,0 +1,252 @@
+\ ** ficl/softwords/softcore.fr
+\ ** FICL soft extensions
+\ ** John Sadler (john_sadler@alum.mit.edu)
+\ ** September, 1998
+
+
+\ ** ficl extras
+\ EMPTY cleans the parameter stack
+: empty   ( xn..x1 -- ) depth 0 ?do drop loop ;
+\ CELL- undoes CELL+
+: cell-   ( addr -- addr )  [ 1 cells ] literal -  ;
+: -rot   ( a b c -- c a b )  2 -roll ;
+
+\ ** CORE
+: abs   ( x -- x )
+    dup 0< if negate endif ;
+decimal 32 constant bl
+
+: space   ( -- )     bl emit ;
+
+: spaces  ( n -- )   0 ?do space loop ;
+
+: abort"
+    state @ if
+        postpone if
+        postpone ."
+        postpone cr
+        -2
+        postpone literal
+        postpone throw
+        postpone endif
+    else
+	    [char] " parse
+        rot if
+            type
+            cr
+            -2 throw
+        else
+            2drop
+        endif
+    endif
+; immediate
+
+\ ** CORE EXT
+.( loading CORE EXT words ) cr
+0  constant false
+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<  ;
+
+: dnegate ( d -- -d ) invert swap negate tuck 0= - ;
+: dabs   ( d -- ud ) dup 0< if dnegate endif ;
+
+: .r ( n +n -- )
+  swap dup abs 0 <# #s rot sign #>
+  rot over - dup 0< if
+    drop else spaces
+  then
+  type space ;
+
+: u.r ( n +n -- )
+  swap 0 <# #s #>
+  rot over - dup 0< if
+    drop else spaces
+  then
+  type space ;
+
+: d. ( d -- )
+  swap over dabs <# #s rot sign #> type space ;
+
+: d.r ( d +n -- )
+  -rot swap over dabs <# #s rot sign #>
+  rot over - dup 0< if
+    drop else spaces
+  then
+  type space ;
+
+: du. ( d -- )
+  <# #s #> type space ;
+
+: du.r ( d +n -- )
+  -rot <# #s #> rot over - dup 0< if drop else spaces then type space ;
+
+: d>s ( d -- n ) drop ;
+
+: d0= ( d -- flag ) or 0= ;
+: d= ( d1 d2 -- flag ) rot = -rot = and ;
+: d0< ( d -- f ) nip 0< ;
+
+: d< ( d1 d2 -- flag )
+  2 pick
+  over
+  = if
+    rot 2drop
+    <
+  else
+    swap drop
+    <
+    swap drop
+  then
+;
+
+: du< d< ;
+: dmax ( d1 d2 -- d3 )
+  2over 2over
+  d< if
+    2swap
+  then
+  2drop
+;
+
+: dmin ( d1 d2 -- d3 )
+  2over 2over
+  d< if
+    2drop
+  else
+    2swap
+    2drop
+  then
+;
+
+: d+ ( d1 d2 -- d3 ) rot + >r tuck + tuck swap u<  r> swap - ;
+: d- ( d1 d2 -- d3 ) dnegate d+ ;
+: d2* ( d1 -- d2 ) 2dup d+ ;
+: d2/ ( d1 -- d2 )
+  dup 1 and >r 2/ swap 2/ [ 1 8 cells 1- lshift 1- ] literal and
+  r> if
+    [ 1 8 cells 1- lshift ] literal +
+  then
+  swap
+;
+
+: m+ ( d1 +n -- d2 ) s>d d+ ;
+
+\ ** TOOLS word set...
+: ?     ( addr -- )  @ . ;
+
+Variable /dump
+
+: i' ( R:w R:w2 -- R:w R:w2 w )
+  r> r> r> dup >r swap >r swap >r ;
+
+: .4 ( addr -- addr' )
+    4 0 DO  -1 /dump +!  /dump @ 0<
+        IF 3 spaces  ELSE  dup c@ 0 <# # # #> type space  THEN
+    char+ LOOP ;
+
+: .chars ( addr -- )
+    /dump @ over + swap
+    ?DO I c@ dup 127 bl within
+        IF  drop [char] .  THEN  emit
+    LOOP ;
+
+: .line ( addr -- )
+  dup .4 space .4 ." - " .4 space .4 drop  16 /dump +!  space .chars ;
+
+: dump  ( addr u -- ) \ tools dump
+    cr base @ >r hex        \ save base on return stack
+    0 ?DO  I' I - 16 min /dump !
+        dup 8 u.r ." : " dup .line cr 16 +
+        16 +LOOP
+    drop r> base ! ;
+
+\ ** SEARCH+EXT words and ficl helpers
+.( loading SEARCH & SEARCH-EXT words ) cr
+\ BRAND-WORDLIST is a helper for ficl-named-wordlist. Usage idiom:
+\   wordlist dup create , brand-wordlist
+\ gets the name of the word made by create and applies it to the wordlist...
+: brand-wordlist  ( wid -- )   last-word >name drop wid-set-name ;
+
+: ficl-named-wordlist  \ ( hash-size name -- ) run: ( -- wid )
+    ficl-wordlist dup create , brand-wordlist does> @ ;
+
+: wordlist   ( -- )
+    1 ficl-wordlist ;
+
+\ FICL-SET-CURRENT sets the compile wordlist and pushes the previous value
+: ficl-set-current   ( wid -- old-wid )
+    get-current swap set-current ;
+
+\ DO_VOCABULARY handles the DOES> part of a VOCABULARY
+\ When executed, new voc replaces top of search stack
+: do-vocabulary   ( -- )
+    does>  @ search> drop >search ;
+
+: ficl-vocabulary   ( nBuckets name -- )
+    ficl-named-wordlist do-vocabulary ;
+
+: vocabulary   ( name -- )
+    1 ficl-vocabulary ;
+
+\ PREVIOUS drops the search order stack
+: previous  ( --  )  search> drop ;
+
+\ HIDDEN vocabulary is a place to keep helper words from cluttering the namespace
+\ USAGE:
+\ hide
+\ <definitions to hide>
+\ set-current
+\ <words that use hidden defs>
+\ previous ( pop HIDDEN off the search order )
+
+1 ficl-named-wordlist hidden
+: hide     hidden dup >search ficl-set-current ;
+
+\ ALSO dups the search stack...
+: also   ( -- )
+    search> dup >search >search ;
+
+\ FORTH drops the top of the search stack and pushes FORTH-WORDLIST
+: forth   ( -- )
+    search> drop
+    forth-wordlist >search ;
+
+\ ONLY sets the search order to a default state
+: only   ( -- )
+    -1 set-order ;
+
+\ ORDER displays the compile wid and the search order list
+hide
+: list-wid ( wid -- )
+    dup wid-get-name   ( wid c-addr u )
+    ?dup if
+        type drop
+    else
+        drop ." (unnamed wid) " x.
+    endif cr
+;
+set-current   \ stop hiding words
+
+: order   ( -- )
+    ." Search:" cr
+    get-order  0 ?do 3 spaces list-wid loop cr
+   ." Compile: " get-current list-wid cr
+;
+
+: debug  ' debug-xt ; immediate
+: on-step   ." S: " .s-simple cr ;
+
+
+previous   \ lose hidden words from search order
+
+\ ** E N D   S O F T C O R E . F R
diff --git a/usr/src/common/ficl/softcore/string.fr b/usr/src/common/ficl/softcore/string.fr
new file mode 100644
index 0000000000..18ef8dcff2
--- /dev/null
+++ b/usr/src/common/ficl/softcore/string.fr
@@ -0,0 +1,149 @@
+S" FICL_WANT_OOP" ENVIRONMENT? drop [if]
+\ ** ficl/softwords/string.fr
+\ A useful dynamic string class
+\ John Sadler 14 Sep 1998
+\
+\ ** C - S T R I N G
+\ counted string, buffer sized dynamically
+\ Creation example:
+\   c-string --> new str
+\   s" arf arf!!" str --> set
+\   s" woof woof woof " str --> cat
+\   str --> type  cr
+\
+
+.( loading ficl string class ) cr
+also oop definitions
+
+object subclass c-string
+    c-cell obj: .count
+    c-cell obj: .buflen
+    c-ptr  obj: .buf
+    32 constant min-buf
+
+    : get-count   ( 2:this -- count )  my=[ .count  get ] ;
+    : set-count   ( count 2:this -- )  my=[ .count  set ] ;
+
+    : ?empty   ( 2:this -- flag )  --> get-count 0= ;
+
+    : get-buflen   ( 2:this -- len )  my=[ .buflen  get ] ;
+    : set-buflen   ( len 2:this -- )  my=[ .buflen  set ] ;
+
+    : get-buf   ( 2:this -- ptr )     my=[ .buf get-ptr ] ;
+    : set-buf   { ptr len 2:this -- }
+        ptr this my=[ .buf set-ptr ]
+        len this my=> set-buflen
+    ;
+
+    \ set buffer to null and buflen to zero
+    : clr-buf   ( 2:this -- )
+        0 0 2over  my=> set-buf
+        0 -rot     my=> set-count
+    ;
+
+    \ free the buffer if there is one, set buf pointer to null
+    : free-buf   { 2:this -- }
+        this my=> get-buf
+        ?dup if
+            free
+			abort" c-string free failed"
+			this  my=> clr-buf
+        endif
+    ;
+
+    \ guarantee buffer is large enough to hold size chars
+    : size-buf  { size 2:this -- }
+        size 0< abort" need positive size for size-buf"
+        size 0= if
+            this --> free-buf exit
+        endif
+
+        \ force buflen to be a positive multiple of min-buf chars
+        my=> min-buf size over / 1+ * chars to size
+
+        \ if buffer is null, allocate one, else resize it
+        this --> get-buflen  0=
+        if
+            size allocate
+            abort" out of memory"
+            size this --> set-buf
+            size this --> set-buflen
+            exit
+        endif
+
+        size this --> get-buflen > if
+            this --> get-buf size resize
+            abort" out of memory"
+            size this --> set-buf
+        endif
+    ;
+
+    : set   { c-addr u 2:this -- }
+        u this --> size-buf
+        u this --> set-count
+        c-addr this --> get-buf  u move
+    ;
+
+    : get   { 2:this -- c-addr u }
+        this --> get-buf
+        this --> get-count
+    ;
+
+    \ append string to existing one
+    : cat   { c-addr u 2:this -- }
+        this --> get-count u +  dup >r
+        this --> size-buf
+        c-addr  this --> get-buf this --> get-count +  u move
+        r> this --> set-count
+    ;
+
+    : type   { 2:this -- }
+	    this --> ?empty if ." (empty) " exit endif
+        this --> .buf --> get-ptr
+        this --> .count --> get
+        type
+    ;
+
+    : compare   ( 2string 2:this -- n )
+        --> get
+        2swap
+        --> get
+        2swap compare
+    ;
+
+    : hashcode   ( 2:this -- hashcode )
+        --> get  hash
+    ;
+
+    \ destructor method (overrides object --> free)
+    : free   ( 2:this -- )  2dup --> free-buf  object => free ;
+
+end-class
+
+c-string subclass c-hashstring
+    c-2byte obj: .hashcode
+
+    : set-hashcode   { 2:this -- }
+        this  --> super --> hashcode
+        this  --> .hashcode --> set
+    ;
+
+    : get-hashcode   ( 2:this -- hashcode )
+        --> .hashcode --> get
+    ;
+
+    : set   ( c-addr u 2:this -- )
+        2swap 2over --> super --> set
+        --> set-hashcode
+    ;
+
+    : cat   ( c-addr u 2:this -- )
+        2swap 2over --> super --> cat
+        --> set-hashcode
+    ;
+
+end-class
+
+previous definitions
+
+[endif]
diff --git a/usr/src/common/ficl/stack.c b/usr/src/common/ficl/stack.c
new file mode 100644
index 0000000000..4970e058bb
--- /dev/null
+++ b/usr/src/common/ficl/stack.c
@@ -0,0 +1,393 @@
+/*
+ * s t a c k . c
+ * Forth Inspired Command Language
+ * Author: John Sadler (john_sadler@alum.mit.edu)
+ * Created: 16 Oct 1997
+ * $Id: stack.c,v 1.11 2010/08/12 13:57:22 asau 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.
+ */
+
+#include "ficl.h"
+
+#define	STKDEPTH(s)	(((s)->top - (s)->base) + 1)
+
+/*
+ * N O T E: Stack convention:
+ *
+ * THIS CHANGED IN FICL 4.0!
+ *
+ * top points to the *current* top data value
+ * push: increment top, store value at top
+ * pop:  fetch value at top, decrement top
+ * Stack grows from low to high memory
+ */
+
+/*
+ * v m C h e c k S t a c k
+ * Check the parameter stack for underflow or overflow.
+ * size controls the type of check: if size is zero,
+ * the function checks the stack state for underflow and overflow.
+ * If size > 0, checks to see that the stack has room to push
+ * that many cells. If less than zero, checks to see that the
+ * stack has room to pop that many cells. If any test fails,
+ * the function throws (via vmThrow) a VM_ERREXIT exception.
+ */
+void
+ficlStackCheck(ficlStack *stack, int popCells, int pushCells)
+{
+#if FICL_ROBUST >= 1
+	int nFree = stack->size - STKDEPTH(stack);
+
+	if (popCells > STKDEPTH(stack))
+		ficlVmThrowError(stack->vm, "Error: %s stack underflow",
+		    stack->name);
+
+	if (nFree < pushCells - popCells)
+		ficlVmThrowError(stack->vm, "Error: %s stack overflow",
+		    stack->name);
+#else /* FICL_ROBUST >= 1 */
+	FICL_IGNORE(stack);
+	FICL_IGNORE(popCells);
+	FICL_IGNORE(pushCells);
+#endif /* FICL_ROBUST >= 1 */
+}
+
+/*
+ * s t a c k C r e a t e
+ */
+
+ficlStack *
+ficlStackCreate(ficlVm *vm, char *name, unsigned size)
+{
+	size_t totalSize = sizeof (ficlStack) + (size * sizeof (ficlCell));
+	ficlStack *stack = ficlMalloc(totalSize);
+
+	FICL_VM_ASSERT(vm, size != 0);
+	FICL_VM_ASSERT(vm, stack != NULL);
+
+	stack->size = size;
+	stack->frame = NULL;
+
+	stack->vm = vm;
+	stack->name = name;
+
+	ficlStackReset(stack);
+	return (stack);
+}
+
+/*
+ *                  s t a c k D e l e t e
+ */
+void
+ficlStackDestroy(ficlStack *stack)
+{
+	if (stack)
+		ficlFree(stack);
+}
+
+/*
+ * s t a c k D e p t h
+ */
+int
+ficlStackDepth(ficlStack *stack)
+{
+	return (STKDEPTH(stack));
+}
+
+/*
+ * s t a c k D r o p
+ */
+void
+ficlStackDrop(ficlStack *stack, int n)
+{
+	FICL_VM_ASSERT(stack->vm, n > 0);
+	stack->top -= n;
+}
+
+/*
+ * s t a c k F e t c h
+ */
+ficlCell
+ficlStackFetch(ficlStack *stack, int n)
+{
+	return (stack->top[-n]);
+}
+
+void
+ficlStackStore(ficlStack *stack, int n, ficlCell c)
+{
+	stack->top[-n] = c;
+}
+
+/*
+ * s t a c k G e t T o p
+ */
+ficlCell
+ficlStackGetTop(ficlStack *stack)
+{
+	return (stack->top[0]);
+}
+
+#if FICL_WANT_LOCALS
+/*
+ * s t a c k L i n k
+ * Link a frame using the stack's frame pointer. Allot space for
+ * size cells in the frame
+ * 1) Push frame
+ * 2) frame = top
+ * 3) top += size
+ */
+void
+ficlStackLink(ficlStack *stack, int size)
+{
+	ficlStackPushPointer(stack, stack->frame);
+	stack->frame = stack->top + 1;
+	stack->top += size;
+}
+
+/*
+ * s t a c k U n l i n k
+ * Unink a stack frame previously created by stackLink
+ * 1) top = frame
+ * 2) frame = pop()
+ */
+void
+ficlStackUnlink(ficlStack *stack)
+{
+	stack->top = stack->frame - 1;
+	stack->frame = ficlStackPopPointer(stack);
+}
+#endif /* FICL_WANT_LOCALS */
+
+/*
+ *                  s t a c k P i c k
+ */
+void
+ficlStackPick(ficlStack *stack, int n)
+{
+	ficlStackPush(stack, ficlStackFetch(stack, n));
+}
+
+/*
+ * s t a c k P o p
+ */
+ficlCell
+ficlStackPop(ficlStack *stack)
+{
+	return (*stack->top--);
+}
+
+void *
+ficlStackPopPointer(ficlStack *stack)
+{
+	return ((*stack->top--).p);
+}
+
+ficlUnsigned
+ficlStackPopUnsigned(ficlStack *stack)
+{
+	return ((*stack->top--).u);
+}
+
+ficlInteger
+ficlStackPopInteger(ficlStack *stack)
+{
+	return ((*stack->top--).i);
+}
+
+ficl2Integer
+ficlStackPop2Integer(ficlStack *stack)
+{
+	ficl2Integer ret;
+	ficlInteger high = ficlStackPopInteger(stack);
+	ficlInteger low = ficlStackPopInteger(stack);
+	FICL_2INTEGER_SET(high, low, ret);
+	return (ret);
+}
+
+ficl2Unsigned
+ficlStackPop2Unsigned(ficlStack *stack)
+{
+	ficl2Unsigned ret;
+	ficlUnsigned high = ficlStackPopUnsigned(stack);
+	ficlUnsigned low = ficlStackPopUnsigned(stack);
+	FICL_2UNSIGNED_SET(high, low, ret);
+	return (ret);
+}
+
+#if (FICL_WANT_FLOAT)
+ficlFloat
+ficlStackPopFloat(ficlStack *stack)
+{
+	return ((*stack->top--).f);
+}
+#endif
+
+/*
+ * s t a c k P u s h
+ */
+void
+ficlStackPush(ficlStack *stack, ficlCell c)
+{
+	*++stack->top = c;
+}
+
+void
+ficlStackPushPointer(ficlStack *stack, void *ptr)
+{
+	ficlCell c;
+
+	c.p = ptr;
+	*++stack->top = c;
+}
+
+void
+ficlStackPushInteger(ficlStack *stack, ficlInteger i)
+{
+	ficlCell c;
+
+	c.i = i;
+	*++stack->top = c;
+}
+
+void
+ficlStackPushUnsigned(ficlStack *stack, ficlUnsigned u)
+{
+	ficlCell c;
+
+	c.u = u;
+	*++stack->top = c;
+}
+
+void
+ficlStackPush2Unsigned(ficlStack *stack, ficl2Unsigned du)
+{
+	ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_LOW(du));
+	ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_HIGH(du));
+}
+
+void
+ficlStackPush2Integer(ficlStack *stack, ficl2Integer di)
+{
+	ficl2Unsigned du;
+	FICL_2UNSIGNED_SET(FICL_2UNSIGNED_GET_HIGH(di),
+	    FICL_2UNSIGNED_GET_LOW(di), du);
+	ficlStackPush2Unsigned(stack, du);
+}
+
+#if (FICL_WANT_FLOAT)
+void
+ficlStackPushFloat(ficlStack *stack, ficlFloat f)
+{
+	ficlCell c;
+
+	c.f = f;
+	*++stack->top = c;
+}
+#endif
+
+/*
+ * s t a c k R e s e t
+ */
+void
+ficlStackReset(ficlStack *stack)
+{
+	stack->top = stack->base - 1;
+}
+
+/*
+ * s t a c k R o l l
+ * Roll nth stack entry to the top (counting from zero), if n is
+ * >= 0. Drop other entries as needed to fill the hole.
+ * If n < 0, roll top-of-stack to nth entry, pushing others
+ * upward as needed to fill the hole.
+ */
+void
+ficlStackRoll(ficlStack *stack, int n)
+{
+	ficlCell c;
+	ficlCell *cell;
+
+	if (n == 0)
+		return;
+	else if (n > 0) {
+		cell = stack->top - n;
+		c = *cell;
+
+		for (; n > 0; --n, cell++) {
+			*cell = cell[1];
+		}
+
+		*cell = c;
+	} else {
+		cell = stack->top;
+		c = *cell;
+
+		for (; n < 0; ++n, cell--) {
+			*cell = cell[-1];
+		}
+
+		*cell = c;
+	}
+}
+
+/*
+ * s t a c k S e t T o p
+ */
+void
+ficlStackSetTop(ficlStack *stack, ficlCell c)
+{
+	FICL_STACK_CHECK(stack, 1, 1);
+	stack->top[0] = c;
+}
+
+void
+ficlStackWalk(ficlStack *stack, ficlStackWalkFunction callback,
+    void *context, ficlInteger bottomToTop)
+{
+	int i;
+	int depth;
+	ficlCell *cell;
+	FICL_STACK_CHECK(stack, 0, 0);
+
+	depth = ficlStackDepth(stack);
+	cell = bottomToTop ? stack->base : stack->top;
+	for (i = 0; i < depth; i++) {
+		if (callback(context, cell) == FICL_FALSE)
+			break;
+		cell += bottomToTop ? 1 : -1;
+	}
+}
diff --git a/usr/src/common/ficl/system.c b/usr/src/common/ficl/system.c
new file mode 100644
index 0000000000..6423a46a0c
--- /dev/null
+++ b/usr/src/common/ficl/system.c
@@ -0,0 +1,456 @@
+/*
+ * f i c l . c
+ * Forth Inspired Command Language - external interface
+ * Author: John Sadler (john_sadler@alum.mit.edu)
+ * Created: 19 July 1997
+ * $Id: system.c,v 1.2 2010/09/10 10:35:54 asau Exp $
+ */
+/*
+ * This is an ANS Forth interpreter written in C.
+ * Ficl uses Forth syntax for its commands, but turns the Forth
+ * model on its head in other respects.
+ * Ficl provides facilities for interoperating
+ * with programs written in C: C functions can be exported to Ficl,
+ * and Ficl commands can be executed via a C calling interface. The
+ * interpreter is re-entrant, so it can be used in multiple instances
+ * in a multitasking system. Unlike Forth, Ficl's outer interpreter
+ * expects a text block as input, and returns to the caller after each
+ * text block, so the data pump is somewhere in external code in the
+ * style of TCL.
+ *
+ * Code is written in ANSI C for portability.
+ */
+/*
+ * 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.
+ */
+
+#include "ficl.h"
+
+/*
+ * System statics
+ * Each ficlSystem 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_WANT_MULTITHREADED 1
+ * and supply your own version of ficlDictionaryLock.
+ */
+
+ficlSystem *ficlSystemGlobal = NULL;
+
+/*
+ * f i c l S e t V e r s i o n E n v
+ * Create a double ficlCell environment constant for the version ID
+ */
+static void
+ficlSystemSetVersion(ficlSystem *system)
+{
+	int major = FICL_VERSION_MAJOR;
+	int minor = FICL_VERSION_MINOR;
+	ficl2Integer combined;
+	ficlDictionary *environment = ficlSystemGetEnvironment(system);
+	FICL_2INTEGER_SET(major, minor, combined);
+	ficlDictionarySet2Constant(environment, "ficl-version", combined);
+	ficlDictionarySetConstant(environment, "ficl-robust",  FICL_ROBUST);
+}
+
+/*
+ * f i c l I n i t S y s t e m
+ * Binds a global dictionary to the interpreter system.
+ * You specify the address and size of the allocated area.
+ * After that, Ficl manages it.
+ * First step is to set up the static pointers to the area.
+ * Then write the "precompiled" portion of the dictionary in.
+ * The dictionary needs to be at least large enough to hold the
+ * precompiled part. Try 1K cells minimum. Use "words" to find
+ * out how much of the dictionary is used at any time.
+ */
+ficlSystem *
+ficlSystemCreate(ficlSystemInformation *fsi)
+{
+	ficlInteger dictionarySize;
+	ficlInteger environmentSize;
+	ficlInteger stackSize;
+	ficlSystem *system;
+	ficlCallback callback;
+	ficlSystemInformation fauxInfo;
+	ficlDictionary *environment;
+
+	if (fsi == NULL) {
+		fsi = &fauxInfo;
+		ficlSystemInformationInitialize(fsi);
+	}
+
+	callback.context = fsi->context;
+	callback.textOut = fsi->textOut;
+	callback.errorOut = fsi->errorOut;
+	callback.system = NULL;
+	callback.vm = NULL;
+
+	FICL_ASSERT(&callback, sizeof (ficlInteger) >= sizeof (void *));
+	FICL_ASSERT(&callback, sizeof (ficlUnsigned) >= sizeof (void *));
+#if (FICL_WANT_FLOAT)
+	FICL_ASSERT(&callback, sizeof (ficlFloat) <= sizeof (ficlInteger));
+#endif
+
+	system = ficlMalloc(sizeof (ficlSystem));
+
+	FICL_ASSERT(&callback, system);
+
+	memset(system, 0, sizeof (ficlSystem));
+
+	dictionarySize = fsi->dictionarySize;
+	if (dictionarySize <= 0)
+		dictionarySize = FICL_DEFAULT_DICTIONARY_SIZE;
+
+	environmentSize = fsi->environmentSize;
+	if (environmentSize <= 0)
+		environmentSize = FICL_DEFAULT_ENVIRONMENT_SIZE;
+
+	stackSize = fsi->stackSize;
+	if (stackSize < FICL_DEFAULT_STACK_SIZE)
+		stackSize = FICL_DEFAULT_STACK_SIZE;
+
+	system->dictionary = ficlDictionaryCreateHashed(system,
+	    (unsigned)dictionarySize, FICL_HASH_SIZE);
+	system->dictionary->forthWordlist->name = "forth-wordlist";
+
+	environment = ficlDictionaryCreate(system, (unsigned)environmentSize);
+	system->environment = environment;
+	system->environment->forthWordlist->name = "environment";
+
+	system->callback.textOut = fsi->textOut;
+	system->callback.errorOut = fsi->errorOut;
+	system->callback.context = fsi->context;
+	system->callback.system = system;
+	system->callback.vm = NULL;
+	system->stackSize = stackSize;
+
+#if FICL_WANT_LOCALS
+	/*
+	 * The locals dictionary is only searched while compiling,
+	 * but this is where speed is most important. On the other
+	 * hand, the dictionary gets emptied after each use of locals
+	 * The need to balance search speed with the cost of the 'empty'
+	 * operation led me to select a single-threaded list...
+	 */
+	system->locals = ficlDictionaryCreate(system,
+	    (unsigned)FICL_MAX_LOCALS * FICL_CELLS_PER_WORD);
+#endif /* FICL_WANT_LOCALS */
+
+	/*
+	 * 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.
+	 */
+	ficlSystemCompileCore(system);
+	ficlSystemCompilePrefix(system);
+
+#if FICL_WANT_FLOAT
+	ficlSystemCompileFloat(system);
+#endif /* FICL_WANT_FLOAT */
+
+#if FICL_WANT_PLATFORM
+	ficlSystemCompilePlatform(system);
+#endif /* FICL_WANT_PLATFORM */
+
+	ficlSystemSetVersion(system);
+
+	/*
+	 * Establish the parse order. Note that prefixes precede numbers -
+	 * this allows constructs like "0b101010" which might parse as a
+	 * hex value otherwise.
+	 */
+	ficlSystemAddPrimitiveParseStep(system, "?word", ficlVmParseWord);
+	ficlSystemAddPrimitiveParseStep(system, "?prefix", ficlVmParsePrefix);
+	ficlSystemAddPrimitiveParseStep(system, "?number", ficlVmParseNumber);
+#if FICL_WANT_FLOAT
+	ficlSystemAddPrimitiveParseStep(system, "?float",
+	    ficlVmParseFloatNumber);
+#endif
+
+	/*
+	 * Now create a temporary VM to compile the softwords. Since all VMs
+	 * are linked into the vmList of ficlSystem, 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...
+	 */
+	ficlSystemCreateVm(system);
+#define	ADD_COMPILE_FLAG(name)	\
+	ficlDictionarySetConstant(environment, #name, name)
+	ADD_COMPILE_FLAG(FICL_WANT_LZ4_SOFTCORE);
+	ADD_COMPILE_FLAG(FICL_WANT_FILE);
+	ADD_COMPILE_FLAG(FICL_WANT_FLOAT);
+	ADD_COMPILE_FLAG(FICL_WANT_DEBUGGER);
+	ADD_COMPILE_FLAG(FICL_WANT_EXTENDED_PREFIX);
+	ADD_COMPILE_FLAG(FICL_WANT_USER);
+	ADD_COMPILE_FLAG(FICL_WANT_LOCALS);
+	ADD_COMPILE_FLAG(FICL_WANT_OOP);
+	ADD_COMPILE_FLAG(FICL_WANT_SOFTWORDS);
+	ADD_COMPILE_FLAG(FICL_WANT_MULTITHREADED);
+	ADD_COMPILE_FLAG(FICL_WANT_OPTIMIZE);
+	ADD_COMPILE_FLAG(FICL_WANT_VCALL);
+
+	ADD_COMPILE_FLAG(FICL_PLATFORM_ALIGNMENT);
+
+	ADD_COMPILE_FLAG(FICL_ROBUST);
+
+#define	ADD_COMPILE_STRING(name)	\
+	ficlDictionarySetConstantString(environment, #name, name)
+	ADD_COMPILE_STRING(FICL_PLATFORM_ARCHITECTURE);
+	ADD_COMPILE_STRING(FICL_PLATFORM_OS);
+
+	ficlSystemCompileSoftCore(system);
+	ficlSystemDestroyVm(system->vmList);
+
+	if (ficlSystemGlobal == NULL)
+		ficlSystemGlobal = system;
+
+	return (system);
+}
+
+/*
+ * f i c l T e r m S y s t e m
+ * Tear the system down by deleting the dictionaries and all VMs.
+ * This saves you from having to keep track of all that stuff.
+ */
+void
+ficlSystemDestroy(ficlSystem *system)
+{
+	if (system->dictionary)
+		ficlDictionaryDestroy(system->dictionary);
+	system->dictionary = NULL;
+
+	if (system->environment)
+		ficlDictionaryDestroy(system->environment);
+	system->environment = NULL;
+
+#if FICL_WANT_LOCALS
+	if (system->locals)
+		ficlDictionaryDestroy(system->locals);
+	system->locals = NULL;
+#endif
+
+	while (system->vmList != NULL) {
+		ficlVm *vm = system->vmList;
+		system->vmList = system->vmList->link;
+		ficlVmDestroy(vm);
+	}
+
+	if (ficlSystemGlobal == system)
+		ficlSystemGlobal = NULL;
+
+	ficlFree(system);
+	system = NULL;
+}
+
+/*
+ * f i c l A d d P a r s e S t e p
+ * Appends a parse step function to the end of the parse list (see
+ * ficlParseStep notes in ficl.h for details). Returns 0 if successful,
+ * nonzero if there's no more room in the list.
+ */
+int
+ficlSystemAddParseStep(ficlSystem *system, ficlWord *word)
+{
+	int i;
+	for (i = 0; i < FICL_MAX_PARSE_STEPS; i++) {
+		if (system->parseList[i] == NULL) {
+			system->parseList[i] = word;
+			return (0);
+		}
+	}
+
+	return (1);
+}
+
+/*
+ * Compile a word into the dictionary that invokes the specified ficlParseStep
+ * function. It is up to the user (as usual in Forth) to make sure the stack
+ * preconditions are valid (there needs to be a counted string on top of the
+ * stack) before using the resulting word.
+ */
+void
+ficlSystemAddPrimitiveParseStep(ficlSystem *system, char *name,
+    ficlParseStep pStep)
+{
+	ficlDictionary *dictionary = system->dictionary;
+	ficlWord *word;
+	ficlCell c;
+
+	word = ficlDictionaryAppendPrimitive(dictionary, name,
+	    ficlPrimitiveParseStepParen, FICL_WORD_DEFAULT);
+
+	c.fn = (void (*)(void))pStep;
+	ficlDictionaryAppendCell(dictionary, c);
+	ficlSystemAddParseStep(system, word);
+}
+
+/*
+ * f i c l N e w V M
+ * Create a new virtual machine and link it into the system list
+ * of VMs for later cleanup by ficlTermSystem.
+ */
+ficlVm *
+ficlSystemCreateVm(ficlSystem *system)
+{
+	ficlVm *vm = ficlVmCreate(NULL, system->stackSize, system->stackSize);
+	vm->link = system->vmList;
+
+	memcpy(&(vm->callback), &(system->callback), sizeof (system->callback));
+	vm->callback.vm = vm;
+	vm->callback.system = system;
+
+	system->vmList = vm;
+	return (vm);
+}
+
+/*
+ * f i c l F r e e V M
+ * Removes the VM in question from the system VM list and deletes the
+ * memory allocated to it. This is an optional call, since ficlTermSystem
+ * will do this cleanup for you. This function is handy if you're going to
+ * do a lot of dynamic creation of VMs.
+ */
+void
+ficlSystemDestroyVm(ficlVm *vm)
+{
+	ficlSystem *system = vm->callback.system;
+	ficlVm *pList = system->vmList;
+
+	FICL_VM_ASSERT(vm, vm != NULL);
+
+	if (system->vmList == vm) {
+		system->vmList = system->vmList->link;
+	} else
+		for (; pList != NULL; pList = pList->link) {
+			if (pList->link == vm) {
+				pList->link = vm->link;
+				break;
+			}
+		}
+
+	if (pList)
+		ficlVmDestroy(vm);
+}
+
+/*
+ * f i c l L o o k u p
+ * Look in the system dictionary for a match to the given name. If
+ * found, return the address of the corresponding ficlWord. Otherwise
+ * return NULL.
+ */
+ficlWord *
+ficlSystemLookup(ficlSystem *system, char *name)
+{
+	ficlString s;
+	FICL_STRING_SET_FROM_CSTRING(s, name);
+	return (ficlDictionaryLookup(system->dictionary, s));
+}
+
+/*
+ * f i c l G e t D i c t
+ * Returns the address of the system dictionary
+ */
+ficlDictionary *
+ficlSystemGetDictionary(ficlSystem *system)
+{
+	return (system->dictionary);
+}
+
+/*
+ * f i c l G e t E n v
+ * Returns the address of the system environment space
+ */
+ficlDictionary *
+ficlSystemGetEnvironment(ficlSystem *system)
+{
+	return (system->environment);
+}
+
+/*
+ * f i c l G e t L o c
+ * Returns the address of the system locals dictionary. This dictionary is
+ * only used during compilation, and is shared by all VMs.
+ */
+#if FICL_WANT_LOCALS
+ficlDictionary *
+ficlSystemGetLocals(ficlSystem *system)
+{
+	return (system->locals);
+}
+#endif
+
+/*
+ * 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
+ficlWord *
+ficlSystemLookupLocal(ficlSystem *system, ficlString name)
+{
+	ficlWord *word = NULL;
+	ficlDictionary *dictionary = system->dictionary;
+	ficlHash *hash = ficlSystemGetLocals(system)->forthWordlist;
+	int i;
+	ficlUnsigned16 hashCode = ficlHashCode(name);
+
+	FICL_SYSTEM_ASSERT(system, hash);
+	FICL_SYSTEM_ASSERT(system, dictionary);
+
+	ficlDictionaryLock(dictionary, FICL_TRUE);
+	/*
+	 * check the locals dictionary first...
+	 */
+	word = ficlHashLookup(hash, name, hashCode);
+
+	/*
+	 * If no joy, (!word) ------------------------------v
+	 * iterate over the search list in the main dictionary
+	 */
+	for (i = (int)dictionary->wordlistCount - 1; (i >= 0) && (!word); --i) {
+		hash = dictionary->wordlists[i];
+		word = ficlHashLookup(hash, name, hashCode);
+	}
+
+	ficlDictionaryLock(dictionary, FICL_FALSE);
+	return (word);
+}
+#endif
diff --git a/usr/src/common/ficl/test/core.fr b/usr/src/common/ficl/test/core.fr
new file mode 100644
index 0000000000..d862ff03ea
--- /dev/null
+++ b/usr/src/common/ficl/test/core.fr
@@ -0,0 +1,995 @@
+\ From: John Hayes S1I
+\ Subject: core.fr
+\ Date: Mon, 27 Nov 95 13:10
+
+\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
+\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
+\ VERSION 1.2
+\ THIS PROGRAM TESTS THE CORE WORDS OF AN ANS FORTH SYSTEM.
+\ THE PROGRAM ASSUMES A TWO'S COMPLEMENT IMPLEMENTATION WHERE
+\ THE RANGE OF SIGNED NUMBERS IS -2^(N-1) ... 2^(N-1)-1 AND
+\ THE RANGE OF UNSIGNED NUMBERS IS 0 ... 2^(N)-1.
+\ I HAVEN'T FIGURED OUT HOW TO TEST KEY, QUIT, ABORT, OR ABORT"...
+\ I ALSO HAVEN'T THOUGHT OF A WAY TO TEST ENVIRONMENT?...
+
+TESTING CORE WORDS
+HEX
+
+\ ------------------------------------------------------------------------
+TESTING BASIC ASSUMPTIONS
+
+{ -> }					\ START WITH CLEAN SLATE
+( TEST IF ANY BITS ARE SET; ANSWER IN BASE 1 )
+{ : BITSSET? IF 0 0 ELSE 0 THEN ; -> }
+{  0 BITSSET? -> 0 }		( ZERO IS ALL BITS CLEAR )
+{  1 BITSSET? -> 0 0 }		( OTHER NUMBER HAVE AT LEAST ONE BIT )
+{ -1 BITSSET? -> 0 0 }
+
+\ ------------------------------------------------------------------------
+TESTING BOOLEANS: INVERT AND OR XOR
+
+{ 0 0 AND -> 0 }
+{ 0 1 AND -> 0 }
+{ 1 0 AND -> 0 }
+{ 1 1 AND -> 1 }
+
+{ 0 INVERT 1 AND -> 1 }
+{ 1 INVERT 1 AND -> 0 }
+
+0	 CONSTANT 0S
+0 INVERT CONSTANT 1S
+
+{ 0S INVERT -> 1S }
+{ 1S INVERT -> 0S }
+
+{ 0S 0S AND -> 0S }
+{ 0S 1S AND -> 0S }
+{ 1S 0S AND -> 0S }
+{ 1S 1S AND -> 1S }
+
+{ 0S 0S OR -> 0S }
+{ 0S 1S OR -> 1S }
+{ 1S 0S OR -> 1S }
+{ 1S 1S OR -> 1S }
+
+{ 0S 0S XOR -> 0S }
+{ 0S 1S XOR -> 1S }
+{ 1S 0S XOR -> 1S }
+{ 1S 1S XOR -> 0S }
+
+\ ------------------------------------------------------------------------
+TESTING 2* 2/ LSHIFT RSHIFT
+
+( WE TRUST 1S, INVERT, AND BITSSET?; WE WILL CONFIRM RSHIFT LATER )
+1S 1 RSHIFT INVERT CONSTANT MSB
+{ MSB BITSSET? -> 0 0 }
+
+{ 0S 2* -> 0S }
+{ 1 2* -> 2 }
+{ 4000 2* -> 8000 }
+{ 1S 2* 1 XOR -> 1S }
+{ MSB 2* -> 0S }
+
+{ 0S 2/ -> 0S }
+{ 1 2/ -> 0 }
+{ 4000 2/ -> 2000 }
+{ 1S 2/ -> 1S }				\ MSB PROPOGATED
+{ 1S 1 XOR 2/ -> 1S }
+{ MSB 2/ MSB AND -> MSB }
+
+{ 1 0 LSHIFT -> 1 }
+{ 1 1 LSHIFT -> 2 }
+{ 1 2 LSHIFT -> 4 }
+{ 1 F LSHIFT -> 8000 }			\ BIGGEST GUARANTEED SHIFT
+{ 1S 1 LSHIFT 1 XOR -> 1S }
+{ MSB 1 LSHIFT -> 0 }
+
+{ 1 0 RSHIFT -> 1 }
+{ 1 1 RSHIFT -> 0 }
+{ 2 1 RSHIFT -> 1 }
+{ 4 2 RSHIFT -> 1 }
+{ 8000 F RSHIFT -> 1 }			\ BIGGEST
+{ MSB 1 RSHIFT MSB AND -> 0 }		\ RSHIFT ZERO FILLS MSBS
+{ MSB 1 RSHIFT 2* -> MSB }
+
+\ ------------------------------------------------------------------------
+TESTING COMPARISONS: 0= = 0< < > U< MIN MAX
+0 INVERT			CONSTANT MAX-UINT
+0 INVERT 1 RSHIFT		CONSTANT MAX-INT
+0 INVERT 1 RSHIFT INVERT	CONSTANT MIN-INT
+0 INVERT 1 RSHIFT		CONSTANT MID-UINT
+0 INVERT 1 RSHIFT INVERT	CONSTANT MID-UINT+1
+
+0S CONSTANT <FALSE>
+1S CONSTANT <TRUE>
+
+{ 0 0= -> <TRUE> }
+{ 1 0= -> <FALSE> }
+{ 2 0= -> <FALSE> }
+{ -1 0= -> <FALSE> }
+{ MAX-UINT 0= -> <FALSE> }
+{ MIN-INT 0= -> <FALSE> }
+{ MAX-INT 0= -> <FALSE> }
+
+{ 0 0 = -> <TRUE> }
+{ 1 1 = -> <TRUE> }
+{ -1 -1 = -> <TRUE> }
+{ 1 0 = -> <FALSE> }
+{ -1 0 = -> <FALSE> }
+{ 0 1 = -> <FALSE> }
+{ 0 -1 = -> <FALSE> }
+
+{ 0 0< -> <FALSE> }
+{ -1 0< -> <TRUE> }
+{ MIN-INT 0< -> <TRUE> }
+{ 1 0< -> <FALSE> }
+{ MAX-INT 0< -> <FALSE> }
+
+{ 0 1 < -> <TRUE> }
+{ 1 2 < -> <TRUE> }
+{ -1 0 < -> <TRUE> }
+{ -1 1 < -> <TRUE> }
+{ MIN-INT 0 < -> <TRUE> }
+{ MIN-INT MAX-INT < -> <TRUE> }
+{ 0 MAX-INT < -> <TRUE> }
+{ 0 0 < -> <FALSE> }
+{ 1 1 < -> <FALSE> }
+{ 1 0 < -> <FALSE> }
+{ 2 1 < -> <FALSE> }
+{ 0 -1 < -> <FALSE> }
+{ 1 -1 < -> <FALSE> }
+{ 0 MIN-INT < -> <FALSE> }
+{ MAX-INT MIN-INT < -> <FALSE> }
+{ MAX-INT 0 < -> <FALSE> }
+
+{ 0 1 > -> <FALSE> }
+{ 1 2 > -> <FALSE> }
+{ -1 0 > -> <FALSE> }
+{ -1 1 > -> <FALSE> }
+{ MIN-INT 0 > -> <FALSE> }
+{ MIN-INT MAX-INT > -> <FALSE> }
+{ 0 MAX-INT > -> <FALSE> }
+{ 0 0 > -> <FALSE> }
+{ 1 1 > -> <FALSE> }
+{ 1 0 > -> <TRUE> }
+{ 2 1 > -> <TRUE> }
+{ 0 -1 > -> <TRUE> }
+{ 1 -1 > -> <TRUE> }
+{ 0 MIN-INT > -> <TRUE> }
+{ MAX-INT MIN-INT > -> <TRUE> }
+{ MAX-INT 0 > -> <TRUE> }
+
+{ 0 1 U< -> <TRUE> }
+{ 1 2 U< -> <TRUE> }
+{ 0 MID-UINT U< -> <TRUE> }
+{ 0 MAX-UINT U< -> <TRUE> }
+{ MID-UINT MAX-UINT U< -> <TRUE> }
+{ 0 0 U< -> <FALSE> }
+{ 1 1 U< -> <FALSE> }
+{ 1 0 U< -> <FALSE> }
+{ 2 1 U< -> <FALSE> }
+{ MID-UINT 0 U< -> <FALSE> }
+{ MAX-UINT 0 U< -> <FALSE> }
+{ MAX-UINT MID-UINT U< -> <FALSE> }
+
+{ 0 1 MIN -> 0 }
+{ 1 2 MIN -> 1 }
+{ -1 0 MIN -> -1 }
+{ -1 1 MIN -> -1 }
+{ MIN-INT 0 MIN -> MIN-INT }
+{ MIN-INT MAX-INT MIN -> MIN-INT }
+{ 0 MAX-INT MIN -> 0 }
+{ 0 0 MIN -> 0 }
+{ 1 1 MIN -> 1 }
+{ 1 0 MIN -> 0 }
+{ 2 1 MIN -> 1 }
+{ 0 -1 MIN -> -1 }
+{ 1 -1 MIN -> -1 }
+{ 0 MIN-INT MIN -> MIN-INT }
+{ MAX-INT MIN-INT MIN -> MIN-INT }
+{ MAX-INT 0 MIN -> 0 }
+
+{ 0 1 MAX -> 1 }
+{ 1 2 MAX -> 2 }
+{ -1 0 MAX -> 0 }
+{ -1 1 MAX -> 1 }
+{ MIN-INT 0 MAX -> 0 }
+{ MIN-INT MAX-INT MAX -> MAX-INT }
+{ 0 MAX-INT MAX -> MAX-INT }
+{ 0 0 MAX -> 0 }
+{ 1 1 MAX -> 1 }
+{ 1 0 MAX -> 1 }
+{ 2 1 MAX -> 2 }
+{ 0 -1 MAX -> 0 }
+{ 1 -1 MAX -> 1 }
+{ 0 MIN-INT MAX -> 0 }
+{ MAX-INT MIN-INT MAX -> MAX-INT }
+{ MAX-INT 0 MAX -> MAX-INT }
+
+\ ------------------------------------------------------------------------
+TESTING STACK OPS: 2DROP 2DUP 2OVER 2SWAP ?DUP DEPTH DROP DUP OVER ROT SWAP
+
+{ 1 2 2DROP -> }
+{ 1 2 2DUP -> 1 2 1 2 }
+{ 1 2 3 4 2OVER -> 1 2 3 4 1 2 }
+{ 1 2 3 4 2SWAP -> 3 4 1 2 }
+{ 0 ?DUP -> 0 }
+{ 1 ?DUP -> 1 1 }
+{ -1 ?DUP -> -1 -1 }
+{ DEPTH -> 0 }
+{ 0 DEPTH -> 0 1 }
+{ 0 1 DEPTH -> 0 1 2 }
+{ 0 DROP -> }
+{ 1 2 DROP -> 1 }
+{ 1 DUP -> 1 1 }
+{ 1 2 OVER -> 1 2 1 }
+{ 1 2 3 ROT -> 2 3 1 }
+{ 1 2 SWAP -> 2 1 }
+
+\ ------------------------------------------------------------------------
+TESTING >R R> R@
+
+{ : GR1 >R R> ; -> }
+{ : GR2 >R R@ R> DROP ; -> }
+{ 123 GR1 -> 123 }
+{ 123 GR2 -> 123 }
+{ 1S GR1 -> 1S }   ( RETURN STACK HOLDS CELLS )
+
+\ ------------------------------------------------------------------------
+TESTING ADD/SUBTRACT: + - 1+ 1- ABS NEGATE
+
+{ 0 5 + -> 5 }
+{ 5 0 + -> 5 }
+{ 0 -5 + -> -5 }
+{ -5 0 + -> -5 }
+{ 1 2 + -> 3 }
+{ 1 -2 + -> -1 }
+{ -1 2 + -> 1 }
+{ -1 -2 + -> -3 }
+{ -1 1 + -> 0 }
+{ MID-UINT 1 + -> MID-UINT+1 }
+
+{ 0 5 - -> -5 }
+{ 5 0 - -> 5 }
+{ 0 -5 - -> 5 }
+{ -5 0 - -> -5 }
+{ 1 2 - -> -1 }
+{ 1 -2 - -> 3 }
+{ -1 2 - -> -3 }
+{ -1 -2 - -> 1 }
+{ 0 1 - -> -1 }
+{ MID-UINT+1 1 - -> MID-UINT }
+
+{ 0 1+ -> 1 }
+{ -1 1+ -> 0 }
+{ 1 1+ -> 2 }
+{ MID-UINT 1+ -> MID-UINT+1 }
+
+{ 2 1- -> 1 }
+{ 1 1- -> 0 }
+{ 0 1- -> -1 }
+{ MID-UINT+1 1- -> MID-UINT }
+
+{ 0 NEGATE -> 0 }
+{ 1 NEGATE -> -1 }
+{ -1 NEGATE -> 1 }
+{ 2 NEGATE -> -2 }
+{ -2 NEGATE -> 2 }
+
+{ 0 ABS -> 0 }
+{ 1 ABS -> 1 }
+{ -1 ABS -> 1 }
+{ MIN-INT ABS -> MID-UINT+1 }
+
+\ ------------------------------------------------------------------------
+TESTING MULTIPLY: S>D * M* UM*
+
+{ 0 S>D -> 0 0 }
+{ 1 S>D -> 1 0 }
+{ 2 S>D -> 2 0 }
+{ -1 S>D -> -1 -1 }
+{ -2 S>D -> -2 -1 }
+{ MIN-INT S>D -> MIN-INT -1 }
+{ MAX-INT S>D -> MAX-INT 0 }
+
+{ 0 0 M* -> 0 S>D }
+{ 0 1 M* -> 0 S>D }
+{ 1 0 M* -> 0 S>D }
+{ 1 2 M* -> 2 S>D }
+{ 2 1 M* -> 2 S>D }
+{ 3 3 M* -> 9 S>D }
+{ -3 3 M* -> -9 S>D }
+{ 3 -3 M* -> -9 S>D }
+{ -3 -3 M* -> 9 S>D }
+{ 0 MIN-INT M* -> 0 S>D }
+{ 1 MIN-INT M* -> MIN-INT S>D }
+{ 2 MIN-INT M* -> 0 1S }
+{ 0 MAX-INT M* -> 0 S>D }
+{ 1 MAX-INT M* -> MAX-INT S>D }
+{ 2 MAX-INT M* -> MAX-INT 1 LSHIFT 0 }
+{ MIN-INT MIN-INT M* -> 0 MSB 1 RSHIFT }
+{ MAX-INT MIN-INT M* -> MSB MSB 2/ }
+{ MAX-INT MAX-INT M* -> 1 MSB 2/ INVERT }
+
+{ 0 0 * -> 0 }				\ TEST IDENTITIES
+{ 0 1 * -> 0 }
+{ 1 0 * -> 0 }
+{ 1 2 * -> 2 }
+{ 2 1 * -> 2 }
+{ 3 3 * -> 9 }
+{ -3 3 * -> -9 }
+{ 3 -3 * -> -9 }
+{ -3 -3 * -> 9 }
+
+{ MID-UINT+1 1 RSHIFT 2 * -> MID-UINT+1 }
+{ MID-UINT+1 2 RSHIFT 4 * -> MID-UINT+1 }
+{ MID-UINT+1 1 RSHIFT MID-UINT+1 OR 2 * -> MID-UINT+1 }
+
+{ 0 0 UM* -> 0 0 }
+{ 0 1 UM* -> 0 0 }
+{ 1 0 UM* -> 0 0 }
+{ 1 2 UM* -> 2 0 }
+{ 2 1 UM* -> 2 0 }
+{ 3 3 UM* -> 9 0 }
+
+{ MID-UINT+1 1 RSHIFT 2 UM* -> MID-UINT+1 0 }
+{ MID-UINT+1 2 UM* -> 0 1 }
+{ MID-UINT+1 4 UM* -> 0 2 }
+{ 1S 2 UM* -> 1S 1 LSHIFT 1 }
+{ MAX-UINT MAX-UINT UM* -> 1 1 INVERT }
+
+\ ------------------------------------------------------------------------
+TESTING DIVIDE: FM/MOD SM/REM UM/MOD */ */MOD / /MOD MOD
+
+{ 0 S>D 1 FM/MOD -> 0 0 }
+{ 1 S>D 1 FM/MOD -> 0 1 }
+{ 2 S>D 1 FM/MOD -> 0 2 }
+{ -1 S>D 1 FM/MOD -> 0 -1 }
+{ -2 S>D 1 FM/MOD -> 0 -2 }
+{ 0 S>D -1 FM/MOD -> 0 0 }
+{ 1 S>D -1 FM/MOD -> 0 -1 }
+{ 2 S>D -1 FM/MOD -> 0 -2 }
+{ -1 S>D -1 FM/MOD -> 0 1 }
+{ -2 S>D -1 FM/MOD -> 0 2 }
+{ 2 S>D 2 FM/MOD -> 0 1 }
+{ -1 S>D -1 FM/MOD -> 0 1 }
+{ -2 S>D -2 FM/MOD -> 0 1 }
+{  7 S>D  3 FM/MOD -> 1 2 }
+{  7 S>D -3 FM/MOD -> -2 -3 }
+{ -7 S>D  3 FM/MOD -> 2 -3 }
+{ -7 S>D -3 FM/MOD -> -1 2 }
+{ MAX-INT S>D 1 FM/MOD -> 0 MAX-INT }
+{ MIN-INT S>D 1 FM/MOD -> 0 MIN-INT }
+{ MAX-INT S>D MAX-INT FM/MOD -> 0 1 }
+{ MIN-INT S>D MIN-INT FM/MOD -> 0 1 }
+{ 1S 1 4 FM/MOD -> 3 MAX-INT }
+{ 1 MIN-INT M* 1 FM/MOD -> 0 MIN-INT }
+{ 1 MIN-INT M* MIN-INT FM/MOD -> 0 1 }
+{ 2 MIN-INT M* 2 FM/MOD -> 0 MIN-INT }
+{ 2 MIN-INT M* MIN-INT FM/MOD -> 0 2 }
+{ 1 MAX-INT M* 1 FM/MOD -> 0 MAX-INT }
+{ 1 MAX-INT M* MAX-INT FM/MOD -> 0 1 }
+{ 2 MAX-INT M* 2 FM/MOD -> 0 MAX-INT }
+{ 2 MAX-INT M* MAX-INT FM/MOD -> 0 2 }
+{ MIN-INT MIN-INT M* MIN-INT FM/MOD -> 0 MIN-INT }
+{ MIN-INT MAX-INT M* MIN-INT FM/MOD -> 0 MAX-INT }
+{ MIN-INT MAX-INT M* MAX-INT FM/MOD -> 0 MIN-INT }
+{ MAX-INT MAX-INT M* MAX-INT FM/MOD -> 0 MAX-INT }
+
+{ 0 S>D 1 SM/REM -> 0 0 }
+{ 1 S>D 1 SM/REM -> 0 1 }
+{ 2 S>D 1 SM/REM -> 0 2 }
+{ -1 S>D 1 SM/REM -> 0 -1 }
+{ -2 S>D 1 SM/REM -> 0 -2 }
+{ 0 S>D -1 SM/REM -> 0 0 }
+{ 1 S>D -1 SM/REM -> 0 -1 }
+{ 2 S>D -1 SM/REM -> 0 -2 }
+{ -1 S>D -1 SM/REM -> 0 1 }
+{ -2 S>D -1 SM/REM -> 0 2 }
+{ 2 S>D 2 SM/REM -> 0 1 }
+{ -1 S>D -1 SM/REM -> 0 1 }
+{ -2 S>D -2 SM/REM -> 0 1 }
+{  7 S>D  3 SM/REM -> 1 2 }
+{  7 S>D -3 SM/REM -> 1 -2 }
+{ -7 S>D  3 SM/REM -> -1 -2 }
+{ -7 S>D -3 SM/REM -> -1 2 }
+{ MAX-INT S>D 1 SM/REM -> 0 MAX-INT }
+{ MIN-INT S>D 1 SM/REM -> 0 MIN-INT }
+{ MAX-INT S>D MAX-INT SM/REM -> 0 1 }
+{ MIN-INT S>D MIN-INT SM/REM -> 0 1 }
+{ 1S 1 4 SM/REM -> 3 MAX-INT }
+{ 2 MIN-INT M* 2 SM/REM -> 0 MIN-INT }
+{ 2 MIN-INT M* MIN-INT SM/REM -> 0 2 }
+{ 2 MAX-INT M* 2 SM/REM -> 0 MAX-INT }
+{ 2 MAX-INT M* MAX-INT SM/REM -> 0 2 }
+{ MIN-INT MIN-INT M* MIN-INT SM/REM -> 0 MIN-INT }
+{ MIN-INT MAX-INT M* MIN-INT SM/REM -> 0 MAX-INT }
+{ MIN-INT MAX-INT M* MAX-INT SM/REM -> 0 MIN-INT }
+{ MAX-INT MAX-INT M* MAX-INT SM/REM -> 0 MAX-INT }
+
+{ 0 0 1 UM/MOD -> 0 0 }
+{ 1 0 1 UM/MOD -> 0 1 }
+{ 1 0 2 UM/MOD -> 1 0 }
+{ 3 0 2 UM/MOD -> 1 1 }
+{ MAX-UINT 2 UM* 2 UM/MOD -> 0 MAX-UINT }
+{ MAX-UINT 2 UM* MAX-UINT UM/MOD -> 0 2 }
+{ MAX-UINT MAX-UINT UM* MAX-UINT UM/MOD -> 0 MAX-UINT }
+
+: IFFLOORED
+   [ -3 2 / -2 = INVERT ] LITERAL IF POSTPONE \ THEN ;
+: IFSYM
+   [ -3 2 / -1 = INVERT ] LITERAL IF POSTPONE \ THEN ;
+
+\ THE SYSTEM MIGHT DO EITHER FLOORED OR SYMMETRIC DIVISION.
+\ SINCE WE HAVE ALREADY TESTED M*, FM/MOD, AND SM/REM WE CAN USE THEM IN TEST.
+IFFLOORED : T/MOD  >R S>D R> FM/MOD ;
+IFFLOORED : T/     T/MOD SWAP DROP ;
+IFFLOORED : TMOD   T/MOD DROP ;
+IFFLOORED : T*/MOD >R M* R> FM/MOD ;
+IFFLOORED : T*/    T*/MOD SWAP DROP ;
+IFSYM     : T/MOD  >R S>D R> SM/REM ;
+IFSYM     : T/     T/MOD SWAP DROP ;
+IFSYM     : TMOD   T/MOD DROP ;
+IFSYM     : T*/MOD >R M* R> SM/REM ;
+IFSYM     : T*/    T*/MOD SWAP DROP ;
+
+{ 0 1 /MOD -> 0 1 T/MOD }
+{ 1 1 /MOD -> 1 1 T/MOD }
+{ 2 1 /MOD -> 2 1 T/MOD }
+{ -1 1 /MOD -> -1 1 T/MOD }
+{ -2 1 /MOD -> -2 1 T/MOD }
+{ 0 -1 /MOD -> 0 -1 T/MOD }
+{ 1 -1 /MOD -> 1 -1 T/MOD }
+{ 2 -1 /MOD -> 2 -1 T/MOD }
+{ -1 -1 /MOD -> -1 -1 T/MOD }
+{ -2 -1 /MOD -> -2 -1 T/MOD }
+{ 2 2 /MOD -> 2 2 T/MOD }
+{ -1 -1 /MOD -> -1 -1 T/MOD }
+{ -2 -2 /MOD -> -2 -2 T/MOD }
+{ 7 3 /MOD -> 7 3 T/MOD }
+{ 7 -3 /MOD -> 7 -3 T/MOD }
+{ -7 3 /MOD -> -7 3 T/MOD }
+{ -7 -3 /MOD -> -7 -3 T/MOD }
+{ MAX-INT 1 /MOD -> MAX-INT 1 T/MOD }
+{ MIN-INT 1 /MOD -> MIN-INT 1 T/MOD }
+{ MAX-INT MAX-INT /MOD -> MAX-INT MAX-INT T/MOD }
+{ MIN-INT MIN-INT /MOD -> MIN-INT MIN-INT T/MOD }
+
+{ 0 1 / -> 0 1 T/ }
+{ 1 1 / -> 1 1 T/ }
+{ 2 1 / -> 2 1 T/ }
+{ -1 1 / -> -1 1 T/ }
+{ -2 1 / -> -2 1 T/ }
+{ 0 -1 / -> 0 -1 T/ }
+{ 1 -1 / -> 1 -1 T/ }
+{ 2 -1 / -> 2 -1 T/ }
+{ -1 -1 / -> -1 -1 T/ }
+{ -2 -1 / -> -2 -1 T/ }
+{ 2 2 / -> 2 2 T/ }
+{ -1 -1 / -> -1 -1 T/ }
+{ -2 -2 / -> -2 -2 T/ }
+{ 7 3 / -> 7 3 T/ }
+{ 7 -3 / -> 7 -3 T/ }
+{ -7 3 / -> -7 3 T/ }
+{ -7 -3 / -> -7 -3 T/ }
+{ MAX-INT 1 / -> MAX-INT 1 T/ }
+{ MIN-INT 1 / -> MIN-INT 1 T/ }
+{ MAX-INT MAX-INT / -> MAX-INT MAX-INT T/ }
+{ MIN-INT MIN-INT / -> MIN-INT MIN-INT T/ }
+
+{ 0 1 MOD -> 0 1 TMOD }
+{ 1 1 MOD -> 1 1 TMOD }
+{ 2 1 MOD -> 2 1 TMOD }
+{ -1 1 MOD -> -1 1 TMOD }
+{ -2 1 MOD -> -2 1 TMOD }
+{ 0 -1 MOD -> 0 -1 TMOD }
+{ 1 -1 MOD -> 1 -1 TMOD }
+{ 2 -1 MOD -> 2 -1 TMOD }
+{ -1 -1 MOD -> -1 -1 TMOD }
+{ -2 -1 MOD -> -2 -1 TMOD }
+{ 2 2 MOD -> 2 2 TMOD }
+{ -1 -1 MOD -> -1 -1 TMOD }
+{ -2 -2 MOD -> -2 -2 TMOD }
+{ 7 3 MOD -> 7 3 TMOD }
+{ 7 -3 MOD -> 7 -3 TMOD }
+{ -7 3 MOD -> -7 3 TMOD }
+{ -7 -3 MOD -> -7 -3 TMOD }
+{ MAX-INT 1 MOD -> MAX-INT 1 TMOD }
+{ MIN-INT 1 MOD -> MIN-INT 1 TMOD }
+{ MAX-INT MAX-INT MOD -> MAX-INT MAX-INT TMOD }
+{ MIN-INT MIN-INT MOD -> MIN-INT MIN-INT TMOD }
+
+{ 0 2 1 */ -> 0 2 1 T*/ }
+{ 1 2 1 */ -> 1 2 1 T*/ }
+{ 2 2 1 */ -> 2 2 1 T*/ }
+{ -1 2 1 */ -> -1 2 1 T*/ }
+{ -2 2 1 */ -> -2 2 1 T*/ }
+{ 0 2 -1 */ -> 0 2 -1 T*/ }
+{ 1 2 -1 */ -> 1 2 -1 T*/ }
+{ 2 2 -1 */ -> 2 2 -1 T*/ }
+{ -1 2 -1 */ -> -1 2 -1 T*/ }
+{ -2 2 -1 */ -> -2 2 -1 T*/ }
+{ 2 2 2 */ -> 2 2 2 T*/ }
+{ -1 2 -1 */ -> -1 2 -1 T*/ }
+{ -2 2 -2 */ -> -2 2 -2 T*/ }
+{ 7 2 3 */ -> 7 2 3 T*/ }
+{ 7 2 -3 */ -> 7 2 -3 T*/ }
+{ -7 2 3 */ -> -7 2 3 T*/ }
+{ -7 2 -3 */ -> -7 2 -3 T*/ }
+{ MAX-INT 2 MAX-INT */ -> MAX-INT 2 MAX-INT T*/ }
+{ MIN-INT 2 MIN-INT */ -> MIN-INT 2 MIN-INT T*/ }
+
+{ 0 2 1 */MOD -> 0 2 1 T*/MOD }
+{ 1 2 1 */MOD -> 1 2 1 T*/MOD }
+{ 2 2 1 */MOD -> 2 2 1 T*/MOD }
+{ -1 2 1 */MOD -> -1 2 1 T*/MOD }
+{ -2 2 1 */MOD -> -2 2 1 T*/MOD }
+{ 0 2 -1 */MOD -> 0 2 -1 T*/MOD }
+{ 1 2 -1 */MOD -> 1 2 -1 T*/MOD }
+{ 2 2 -1 */MOD -> 2 2 -1 T*/MOD }
+{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }
+{ -2 2 -1 */MOD -> -2 2 -1 T*/MOD }
+{ 2 2 2 */MOD -> 2 2 2 T*/MOD }
+{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }
+{ -2 2 -2 */MOD -> -2 2 -2 T*/MOD }
+{ 7 2 3 */MOD -> 7 2 3 T*/MOD }
+{ 7 2 -3 */MOD -> 7 2 -3 T*/MOD }
+{ -7 2 3 */MOD -> -7 2 3 T*/MOD }
+{ -7 2 -3 */MOD -> -7 2 -3 T*/MOD }
+{ MAX-INT 2 MAX-INT */MOD -> MAX-INT 2 MAX-INT T*/MOD }
+{ MIN-INT 2 MIN-INT */MOD -> MIN-INT 2 MIN-INT T*/MOD }
+
+\ ------------------------------------------------------------------------
+TESTING HERE , @ ! CELL+ CELLS C, C@ C! CHARS 2@ 2! ALIGN ALIGNED +! ALLOT
+
+HERE 1 ALLOT
+HERE
+CONSTANT 2NDA
+CONSTANT 1STA
+{ 1STA 2NDA U< -> <TRUE> }		\ HERE MUST GROW WITH ALLOT
+{ 1STA 1+ -> 2NDA }			\ ... BY ONE ADDRESS UNIT
+( MISSING TEST: NEGATIVE ALLOT )
+
+HERE 1 ,
+HERE 2 ,
+CONSTANT 2ND
+CONSTANT 1ST
+{ 1ST 2ND U< -> <TRUE> }			\ HERE MUST GROW WITH ALLOT
+{ 1ST CELL+ -> 2ND }			\ ... BY ONE CELL
+{ 1ST 1 CELLS + -> 2ND }
+{ 1ST @ 2ND @ -> 1 2 }
+{ 5 1ST ! -> }
+{ 1ST @ 2ND @ -> 5 2 }
+{ 6 2ND ! -> }
+{ 1ST @ 2ND @ -> 5 6 }
+{ 1ST 2@ -> 6 5 }
+{ 2 1 1ST 2! -> }
+{ 1ST 2@ -> 2 1 }
+{ 1S 1ST !  1ST @ -> 1S }		\ CAN STORE CELL-WIDE VALUE
+
+HERE 1 C,
+HERE 2 C,
+CONSTANT 2NDC
+CONSTANT 1STC
+{ 1STC 2NDC U< -> <TRUE> }		\ HERE MUST GROW WITH ALLOT
+{ 1STC CHAR+ -> 2NDC }			\ ... BY ONE CHAR
+{ 1STC 1 CHARS + -> 2NDC }
+{ 1STC C@ 2NDC C@ -> 1 2 }
+{ 3 1STC C! -> }
+{ 1STC C@ 2NDC C@ -> 3 2 }
+{ 4 2NDC C! -> }
+{ 1STC C@ 2NDC C@ -> 3 4 }
+
+ALIGN 1 ALLOT HERE ALIGN HERE 3 CELLS ALLOT
+CONSTANT A-ADDR  CONSTANT UA-ADDR
+{ UA-ADDR ALIGNED -> A-ADDR }
+{    1 A-ADDR C!  A-ADDR C@ ->    1 }
+{ 1234 A-ADDR  !  A-ADDR  @ -> 1234 }
+{ 123 456 A-ADDR 2!  A-ADDR 2@ -> 123 456 }
+{ 2 A-ADDR CHAR+ C!  A-ADDR CHAR+ C@ -> 2 }
+{ 3 A-ADDR CELL+ C!  A-ADDR CELL+ C@ -> 3 }
+{ 1234 A-ADDR CELL+ !  A-ADDR CELL+ @ -> 1234 }
+{ 123 456 A-ADDR CELL+ 2!  A-ADDR CELL+ 2@ -> 123 456 }
+
+: BITS ( X -- U )
+   0 SWAP BEGIN DUP WHILE DUP MSB AND IF >R 1+ R> THEN 2* REPEAT DROP ;
+( CHARACTERS >= 1 AU, <= SIZE OF CELL, >= 8 BITS )
+{ 1 CHARS 1 < -> <FALSE> }
+{ 1 CHARS 1 CELLS > -> <FALSE> }
+( TBD: HOW TO FIND NUMBER OF BITS? )
+
+( CELLS >= 1 AU, INTEGRAL MULTIPLE OF CHAR SIZE, >= 16 BITS )
+{ 1 CELLS 1 < -> <FALSE> }
+{ 1 CELLS 1 CHARS MOD -> 0 }
+{ 1S BITS 10 < -> <FALSE> }
+
+{ 0 1ST ! -> }
+{ 1 1ST +! -> }
+{ 1ST @ -> 1 }
+{ -1 1ST +! 1ST @ -> 0 }
+
+\ ------------------------------------------------------------------------
+TESTING CHAR [CHAR] [ ] BL S"
+
+{ BL -> 20 }
+{ CHAR X -> 58 }
+{ CHAR HELLO -> 48 }
+{ : GC1 [CHAR] X ; -> }
+{ : GC2 [CHAR] HELLO ; -> }
+{ GC1 -> 58 }
+{ GC2 -> 48 }
+{ : GC3 [ GC1 ] LITERAL ; -> }
+{ GC3 -> 58 }
+{ : GC4 S" XY" ; -> }
+{ GC4 SWAP DROP -> 2 }
+{ GC4 DROP DUP C@ SWAP CHAR+ C@ -> 58 59 }
+
+\ ------------------------------------------------------------------------
+TESTING ' ['] FIND EXECUTE IMMEDIATE COUNT LITERAL POSTPONE STATE
+
+{ : GT1 123 ; -> }
+{ ' GT1 EXECUTE -> 123 }
+{ : GT2 ['] GT1 ; IMMEDIATE -> }
+{ GT2 EXECUTE -> 123 }
+
+HERE 3 C, CHAR G C, CHAR T C, CHAR 1 C, CONSTANT GT1STRING
+HERE 3 C, CHAR G C, CHAR T C, CHAR 2 C, CONSTANT GT2STRING
+
+{ GT1STRING FIND -> ' GT1 -1 }
+{ GT2STRING FIND -> ' GT2 1 }
+( HOW TO SEARCH FOR NON-EXISTENT WORD? )
+{ : GT3 GT2 LITERAL ; -> }
+{ GT3 -> ' GT1 }
+{ GT1STRING COUNT -> GT1STRING CHAR+ 3 }
+
+{ : GT4 POSTPONE GT1 ; IMMEDIATE -> }
+{ : GT5 GT4 ; -> }
+{ GT5 -> 123 }
+{ : GT6 345 ; IMMEDIATE -> }
+{ : GT7 POSTPONE GT6 ; -> }
+{ GT7 -> 345 }
+
+{ : GT8 STATE @ ; IMMEDIATE -> }
+{ GT8 -> 0 }
+{ : GT9 GT8 LITERAL ; -> }
+{ GT9 0= -> <FALSE> }
+
+\ ------------------------------------------------------------------------
+TESTING IF ELSE THEN BEGIN WHILE REPEAT UNTIL RECURSE
+
+{ : GI1 IF 123 THEN ; -> }
+{ : GI2 IF 123 ELSE 234 THEN ; -> }
+{ 0 GI1 -> }
+{ 1 GI1 -> 123 }
+{ -1 GI1 -> 123 }
+{ 0 GI2 -> 234 }
+{ 1 GI2 -> 123 }
+{ -1 GI1 -> 123 }
+
+{ : GI3 BEGIN DUP 5 < WHILE DUP 1+ REPEAT ; -> }
+{ 0 GI3 -> 0 1 2 3 4 5 }
+{ 4 GI3 -> 4 5 }
+{ 5 GI3 -> 5 }
+{ 6 GI3 -> 6 }
+
+{ : GI4 BEGIN DUP 1+ DUP 5 > UNTIL ; -> }
+{ 3 GI4 -> 3 4 5 6 }
+{ 5 GI4 -> 5 6 }
+{ 6 GI4 -> 6 7 }
+
+{ : GI5 BEGIN DUP 2 > WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }
+{ 1 GI5 -> 1 345 }
+{ 2 GI5 -> 2 345 }
+{ 3 GI5 -> 3 4 5 123 }
+{ 4 GI5 -> 4 5 123 }
+{ 5 GI5 -> 5 123 }
+
+{ : GI6 ( N -- 0,1,..N ) DUP IF DUP >R 1- RECURSE R> THEN ; -> }
+{ 0 GI6 -> 0 }
+{ 1 GI6 -> 0 1 }
+{ 2 GI6 -> 0 1 2 }
+{ 3 GI6 -> 0 1 2 3 }
+{ 4 GI6 -> 0 1 2 3 4 }
+
+\ ------------------------------------------------------------------------
+TESTING DO LOOP +LOOP I J UNLOOP LEAVE EXIT
+
+{ : GD1 DO I LOOP ; -> }
+{ 4 1 GD1 -> 1 2 3 }
+{ 2 -1 GD1 -> -1 0 1 }
+{ MID-UINT+1 MID-UINT GD1 -> MID-UINT }
+
+{ : GD2 DO I -1 +LOOP ; -> }
+{ 1 4 GD2 -> 4 3 2 1 }
+{ -1 2 GD2 -> 2 1 0 -1 }
+{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }
+
+{ : GD3 DO 1 0 DO J LOOP LOOP ; -> }
+{ 4 1 GD3 -> 1 2 3 }
+{ 2 -1 GD3 -> -1 0 1 }
+{ MID-UINT+1 MID-UINT GD3 -> MID-UINT }
+
+{ : GD4 DO 1 0 DO J LOOP -1 +LOOP ; -> }
+{ 1 4 GD4 -> 4 3 2 1 }
+{ -1 2 GD4 -> 2 1 0 -1 }
+{ MID-UINT MID-UINT+1 GD4 -> MID-UINT+1 MID-UINT }
+
+{ : GD5 123 SWAP 0 DO I 4 > IF DROP 234 LEAVE THEN LOOP ; -> }
+{ 1 GD5 -> 123 }
+{ 5 GD5 -> 123 }
+{ 6 GD5 -> 234 }
+
+{ : GD6  ( PAT: {0 0},{0 0}{1 0}{1 1},{0 0}{1 0}{1 1}{2 0}{2 1}{2 2} )
+   0 SWAP 0 DO
+      I 1+ 0 DO I J + 3 = IF I UNLOOP I UNLOOP EXIT THEN 1+ LOOP
+    LOOP ; -> }
+{ 1 GD6 -> 1 }
+{ 2 GD6 -> 3 }
+{ 3 GD6 -> 4 1 2 }
+
+\ ------------------------------------------------------------------------
+TESTING DEFINING WORDS: : ; CONSTANT VARIABLE CREATE DOES> >BODY
+
+{ 123 CONSTANT X123 -> }
+{ X123 -> 123 }
+{ : EQU CONSTANT ; -> }
+{ X123 EQU Y123 -> }
+{ Y123 -> 123 }
+
+{ VARIABLE V1 -> }
+{ 123 V1 ! -> }
+{ V1 @ -> 123 }
+
+{ : NOP : POSTPONE ; ; -> }
+{ NOP NOP1 NOP NOP2 -> }
+{ NOP1 -> }
+{ NOP2 -> }
+
+{ : DOES1 DOES> @ 1 + ; -> }
+{ : DOES2 DOES> @ 2 + ; -> }
+{ CREATE CR1 -> }
+{ CR1 -> HERE }
+{ ' CR1 >BODY -> HERE }
+{ 1 , -> }
+{ CR1 @ -> 1 }
+{ DOES1 -> }
+{ CR1 -> 2 }
+{ DOES2 -> }
+{ CR1 -> 3 }
+
+{ : WEIRD: CREATE DOES> 1 + DOES> 2 + ; -> }
+{ WEIRD: W1 -> }
+{ ' W1 >BODY -> HERE }
+{ W1 -> HERE 1 + }
+{ W1 -> HERE 2 + }
+
+\ ------------------------------------------------------------------------
+TESTING EVALUATE
+
+: GE1 S" 123" ; IMMEDIATE
+: GE2 S" 123 1+" ; IMMEDIATE
+: GE3 S" : GE4 345 ;" ;
+: GE5 EVALUATE ; IMMEDIATE
+
+{ GE1 EVALUATE -> 123 }			( TEST EVALUATE IN INTERP. STATE )
+{ GE2 EVALUATE -> 124 }
+{ GE3 EVALUATE -> }
+{ GE4 -> 345 }
+
+{ : GE6 GE1 GE5 ; -> }			( TEST EVALUATE IN COMPILE STATE )
+{ GE6 -> 123 }
+{ : GE7 GE2 GE5 ; -> }
+{ GE7 -> 124 }
+
+\ ------------------------------------------------------------------------
+TESTING SOURCE >IN WORD
+
+: GS1 S" SOURCE" 2DUP EVALUATE
+       >R SWAP >R = R> R> = ;
+{ GS1 -> <TRUE> <TRUE> }
+
+VARIABLE SCANS
+: RESCAN?  -1 SCANS +! SCANS @ IF 0 >IN ! THEN ;
+
+{ 2 SCANS !
+345 RESCAN?
+-> 345 345 }
+: GS2  5 SCANS ! S" 123 RESCAN?" EVALUATE ;
+{ GS2 -> 123 123 123 123 123 }
+
+: GS3 WORD COUNT SWAP C@ ;
+{ BL GS3 HELLO -> 5 CHAR H }
+{ CHAR " GS3 GOODBYE" -> 7 CHAR G }
+{ BL GS3
+DROP -> 0 }				\ BLANK LINE RETURN ZERO-LENGTH STRING
+
+: GS4 SOURCE >IN ! DROP ;
+{ GS4 123 456
+-> }
+
+\ ------------------------------------------------------------------------
+TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL
+
+: S=  \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS.
+   >R SWAP R@ = IF			\ MAKE SURE STRINGS HAVE SAME LENGTH
+      R> ?DUP IF			\ IF NON-EMPTY STRINGS
+	 0 DO
+	    OVER C@ OVER C@ - IF 2DROP <FALSE> UNLOOP EXIT THEN
+	    SWAP CHAR+ SWAP CHAR+
+         LOOP
+      THEN
+      2DROP <TRUE>			\ IF WE GET HERE, STRINGS MATCH
+   ELSE
+      R> DROP 2DROP <FALSE>		\ LENGTHS MISMATCH
+   THEN ;
+
+: GP1  <# 41 HOLD 42 HOLD 0 0 #> S" BA" S= ;
+{ GP1 -> <TRUE> }
+
+: GP2  <# -1 SIGN 0 SIGN -1 SIGN 0 0 #> S" --" S= ;
+{ GP2 -> <TRUE> }
+
+: GP3  <# 1 0 # # #> S" 01" S= ;
+{ GP3 -> <TRUE> }
+
+: GP4  <# 1 0 #S #> S" 1" S= ;
+{ GP4 -> <TRUE> }
+
+24 CONSTANT MAX-BASE			\ BASE 2 .. 36
+: COUNT-BITS
+   0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ;
+COUNT-BITS 2* CONSTANT #BITS-UD		\ NUMBER OF BITS IN UD
+
+: GP5
+   BASE @ <TRUE>
+   MAX-BASE 1+ 2 DO			\ FOR EACH POSSIBLE BASE
+      I BASE !				\ TBD: ASSUMES BASE WORKS
+      I 0 <# #S #> S" 10" S= AND
+   LOOP
+   SWAP BASE ! ;
+{ GP5 -> <TRUE> }
+
+: GP6
+   BASE @ >R  2 BASE !
+   MAX-UINT MAX-UINT <# #S #>		\ MAXIMUM UD TO BINARY
+   R> BASE !				\ S: C-ADDR U
+   DUP #BITS-UD = SWAP
+   0 DO					\ S: C-ADDR FLAG
+      OVER C@ [CHAR] 1 = AND		\ ALL ONES
+      >R CHAR+ R>
+   LOOP SWAP DROP ;
+{ GP6 -> <TRUE> }
+
+: GP7
+   BASE @ >R    MAX-BASE BASE !
+   <TRUE>
+   A 0 DO
+      I 0 <# #S #>
+      1 = SWAP C@ I 30 + = AND AND
+   LOOP
+   MAX-BASE A DO
+      I 0 <# #S #>
+      1 = SWAP C@ 41 I A - + = AND AND
+   LOOP
+   R> BASE ! ;
+
+{ GP7 -> <TRUE> }
+
+\ >NUMBER TESTS
+CREATE GN-BUF 0 C,
+: GN-STRING	GN-BUF 1 ;
+: GN-CONSUMED	GN-BUF CHAR+ 0 ;
+: GN'		[CHAR] ' WORD CHAR+ C@ GN-BUF C!  GN-STRING ;
+
+{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }
+{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }
+{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }
+{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING }	\ SHOULD FAIL TO CONVERT THESE
+{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING }
+{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }
+
+: >NUMBER-BASED
+   BASE @ >R BASE ! >NUMBER R> BASE ! ;
+
+{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }
+{ 0 0 GN' 2'  2 >NUMBER-BASED -> 0 0 GN-STRING }
+{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED }
+{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING }
+{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }
+{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED }
+
+: GN1	\ ( UD BASE -- UD' LEN ) UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO.
+   BASE @ >R BASE !
+   <# #S #>
+   0 0 2SWAP >NUMBER SWAP DROP		\ RETURN LENGTH ONLY
+   R> BASE ! ;
+{ 0 0 2 GN1 -> 0 0 0 }
+{ MAX-UINT 0 2 GN1 -> MAX-UINT 0 0 }
+{ MAX-UINT DUP 2 GN1 -> MAX-UINT DUP 0 }
+{ 0 0 MAX-BASE GN1 -> 0 0 0 }
+{ MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 }
+{ MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 }
+
+: GN2	\ ( -- 16 10 )
+   BASE @ >R  HEX BASE @  DECIMAL BASE @  R> BASE ! ;
+{ GN2 -> 10 A }
+
+\ ------------------------------------------------------------------------
+TESTING FILL MOVE
+
+CREATE FBUF 00 C, 00 C, 00 C,
+CREATE SBUF 12 C, 34 C, 56 C,
+: SEEBUF FBUF C@  FBUF CHAR+ C@  FBUF CHAR+ CHAR+ C@ ;
+
+{ FBUF 0 20 FILL -> }
+{ SEEBUF -> 00 00 00 }
+
+{ FBUF 1 20 FILL -> }
+{ SEEBUF -> 20 00 00 }
+
+{ FBUF 3 20 FILL -> }
+{ SEEBUF -> 20 20 20 }
+
+{ FBUF FBUF 3 CHARS MOVE -> }		\ BIZARRE SPECIAL CASE
+{ SEEBUF -> 20 20 20 }
+
+{ SBUF FBUF 0 CHARS MOVE -> }
+{ SEEBUF -> 20 20 20 }
+
+{ SBUF FBUF 1 CHARS MOVE -> }
+{ SEEBUF -> 12 20 20 }
+
+{ SBUF FBUF 3 CHARS MOVE -> }
+{ SEEBUF -> 12 34 56 }
+
+{ FBUF FBUF CHAR+ 2 CHARS MOVE -> }
+{ SEEBUF -> 12 12 34 }
+
+{ FBUF CHAR+ FBUF 2 CHARS MOVE -> }
+{ SEEBUF -> 12 34 34 }
+
+\ ------------------------------------------------------------------------
+TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U.
+
+: OUTPUT-TEST
+   ." YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:" CR
+   41 BL DO I EMIT LOOP CR
+   61 41 DO I EMIT LOOP CR
+   7F 61 DO I EMIT LOOP CR
+   ." YOU SHOULD SEE 0-9 SEPARATED BY A SPACE:" CR
+   9 1+ 0 DO I . LOOP CR
+   ." YOU SHOULD SEE 0-9 (WITH NO SPACES):" CR
+   [CHAR] 9 1+ [CHAR] 0 DO I 0 SPACES EMIT LOOP CR
+   ." YOU SHOULD SEE A-G SEPARATED BY A SPACE:" CR
+   [CHAR] G 1+ [CHAR] A DO I EMIT SPACE LOOP CR
+   ." YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES:" CR
+   5 1+ 0 DO I [CHAR] 0 + EMIT 2 SPACES LOOP CR
+   ." YOU SHOULD SEE TWO SEPARATE LINES:" CR
+   S" LINE 1" TYPE CR S" LINE 2" TYPE CR
+   ." YOU SHOULD SEE THE NUMBER RANGES OF SIGNED AND UNSIGNED NUMBERS:" CR
+   ."   SIGNED: " MIN-INT . MAX-INT . CR
+   ." UNSIGNED: " 0 U. MAX-UINT U. CR
+;
+
+{ OUTPUT-TEST -> }
+
+\ ------------------------------------------------------------------------
+TESTING INPUT: ACCEPT
+
+CREATE ABUF 80 CHARS ALLOT
+
+: ACCEPT-TEST
+   CR ." PLEASE TYPE UP TO 80 CHARACTERS:" CR
+   ABUF 80 ACCEPT
+   CR ." RECEIVED: " [CHAR] " EMIT
+   ABUF SWAP TYPE [CHAR] " EMIT CR
+;
+
+{ ACCEPT-TEST -> }
+
+\ ------------------------------------------------------------------------
+TESTING DICTIONARY SEARCH RULES
+
+{ : GDX   123 ; : GDX   GDX 234 ; -> }
+
+{ GDX -> 123 234 }
diff --git a/usr/src/common/ficl/test/fib.fr b/usr/src/common/ficl/test/fib.fr
new file mode 100644
index 0000000000..b786d0ee02
--- /dev/null
+++ b/usr/src/common/ficl/test/fib.fr
@@ -0,0 +1,11 @@
+: fib ( n1 -- n2 )
+    dup 1 > if
+	dup
+	1- recurse
+	swap 2 - recurse
+	+
+    then ;
+
+
+35 value nfibs
+: fibtest nfibs fib . cr ;
diff --git a/usr/src/common/ficl/test/ficltest.fr b/usr/src/common/ficl/test/ficltest.fr
new file mode 100644
index 0000000000..b500e9e7ca
--- /dev/null
+++ b/usr/src/common/ficl/test/ficltest.fr
@@ -0,0 +1,105 @@
+\ test file for ficl
+\ test ANSI CORE stuff first...
+-1 set-order
+
+\ set up local variable regressions before { gets redefined!
+: local1 { a b c | clr -- c b a 0 }
+    c b a clr
+;
+
+: local2 { | clr -- 0 } clr ;
+: local3 { a b | c }
+    a to c
+    b to a
+    c to b
+    a b
+;
+
+include tester.fr
+include core.fr
+
+{ -> }
+\ test double stuff
+testing 2>r 2r> 2r@
+: 2r1  2>r r> r> swap ;
+: 2r2  swap >r >r 2r> ;
+: 2r3  2>r 2r@ R> R> 2DUP >R >R SWAP 2r> ;
+
+{ 1 2 2r1 -> 1 2 }
+{ 1 2 2r2 -> 1 2 }
+{ 1 2 2r3 -> 1 2 1 2 1 2 }
+{ -> }
+
+\ Now test ficl extras and optional word-sets
+testing locals
+{ 1 2 3 local1 -> 3 2 1 0 }
+{ local2 -> 0 }
+{ 1 local2 -> 1 0 }
+{ 1 2 local3 -> 2 1 }
+
+testing :noname
+{ :noname 1 ; execute -> 1 }
+{ 1 2 3 -rot -> 3 1 2 }
+
+testing default search order
+{ get-order -> forth-wordlist 1 }
+{ only definitions get-order -> forth-wordlist 1 }
+
+testing forget
+here constant fence
+{ fence forget fence -> here }
+
+testing within
+{ -1 1 0    within -> true }
+{  0 1s 2   within -> true }
+{ -100 0 -1 within -> true }
+{ -1 1 2    within -> false }
+{ -1 1 -2   within -> false }
+{ 1 -5 5    within -> true }
+{ 33000 32000 34000 within -> true }
+{ 0x80000000 0x7f000000 0x81000000 within -> true }
+
+testing exception words
+: exc1 1 throw ;
+: exctest1 [ ' exc1 ] literal catch ;
+: exc2 exctest1 1 = if 2 throw endif ;
+: exctest2 [ ' exc2 ] literal catch ;
+: exctest? ' catch ;
+
+{ exctest1 -> 1 }
+{ exctest2 -> 2 }
+{ exctest? abort -> -1 }
+
+testing refill
+\ from file loading
+0 [if]
+.( Error )
+[else]
+1 [if]
+[else]
+.( Error )
+[then]
+[then]
+
+\ refill from evaluate string
+{ -> }
+{ s" 1 refill 2 " evaluate -> 1 0 2 }
+
+
+testing prefixes
+{ 0x10 -> decimal 16 }
+{ hex 0d10 -> decimal 10 }
+{ hex 100
+-> decimal 256 }
+
+testing number builder
+{ 1 -> 1 }
+{ 3. -> 3 0 }
+
+
+s" ficlwin" environment?
+[if]
+drop
+testing OOP support
+include ooptest.fr
+[endif]
diff --git a/usr/src/common/ficl/test/ooptest.fr b/usr/src/common/ficl/test/ooptest.fr
new file mode 100644
index 0000000000..2f3cb131b0
--- /dev/null
+++ b/usr/src/common/ficl/test/ooptest.fr
@@ -0,0 +1,73 @@
+\ OOP test stuff
+
+only
+also oop definitions
+
+object subclass c-aggregate
+c-byte obj: m0
+c-byte obj: m1
+c-4byte obj: m2
+c-2byte obj: m3
+end-class
+
+object --> sub class1
+
+cell: .a
+cell: .b
+: init
+	locals| class inst |
+	0 inst class --> .a !
+	1 inst class --> .b !
+;
+end-class
+
+class1 --> new c1inst
+
+class1 --> sub class2
+cell: .c
+cell: .d
+
+: init
+	locals| class inst |
+	inst class --> super --> init
+	2 inst class --> .c !
+	3 inst class --> .d !
+;
+end-class
+
+class2 --> new c2inst
+
+object subclass c-list
+c-list ref: link
+c-ref  obj: payload
+end-class
+
+\ test stuff from ficl.html
+.( metaclass methods ) cr
+metaclass --> methods
+
+cr .( c-foo class ) cr
+object --> sub c-foo
+cell: m_cell1
+    4 chars: m_chars
+    : init   ( inst class -- )
+        locals| class inst |
+        0 inst class --> m_cell1 !
+        inst class --> m_chars 4 0 fill
+        ." initializing an instance of c_foo at " inst x. cr
+    ;
+end-class
+
+.( c-foo instance methods... ) cr
+c-foo --> new foo-instance
+cr
+foo-instance --> methods
+foo-instance --> pedigree
+cr
+foo-instance 2dup
+    --> methods
+    --> pedigree
+cr
+c-foo --> see init
+cr
+foo-instance --> class --> see init
diff --git a/usr/src/common/ficl/test/prefix.fr b/usr/src/common/ficl/test/prefix.fr
new file mode 100644
index 0000000000..54e0d03277
--- /dev/null
+++ b/usr/src/common/ficl/test/prefix.fr
@@ -0,0 +1,6 @@
+: 0x  { | old-base -- n }
+    base @ to old-base
+    16 base !
+    0 0 parse-word >number 2drop drop
+    old-base base !
+;
diff --git a/usr/src/common/ficl/test/sarray.fr b/usr/src/common/ficl/test/sarray.fr
new file mode 100644
index 0000000000..635161e18a
--- /dev/null
+++ b/usr/src/common/ficl/test/sarray.fr
@@ -0,0 +1,16 @@
+\ test file for ficl
+\ string array...
+: $array ( caddr u ... caddr u n -- )
+    create 0 ?do , , loop
+    does> swap 2* cells + 2@ type
+;
+
+: s
+    s" string 3"
+    s" string 2"
+    s" string 1"
+    s" string 0"
+    4
+;
+
+s $array s
diff --git a/usr/src/common/ficl/test/testcase.fr b/usr/src/common/ficl/test/testcase.fr
new file mode 100644
index 0000000000..9e3f260b13
--- /dev/null
+++ b/usr/src/common/ficl/test/testcase.fr
@@ -0,0 +1,84 @@
+
+
+1 2 3
+.s-simple
+cr
+
+: test-case ( n -- )
+	case
+		0 of
+			." zero"
+			endof
+		1 of
+			." one"
+			endof
+		." something else"
+	endcase
+	cr
+	;
+
+
+see test-case
+
+.( You should see [3] 1 2 3 -> )
+.s-simple
+.( <-) cr
+
+.( You should see "zero": )
+0 test-case
+
+.( You should see "one": )
+1 test-case
+
+.( You should see "something else": )
+324 test-case
+
+.( You should still see [3] 1 2 3 -> )
+.s-simple
+.( <-) cr
+
+
+: test-case-2 ( n -- )
+	case
+		0 of
+			." zero"
+			fallthrough
+		1 of
+			." one"
+			endof
+		2 of
+			." two"
+			fallthrough
+		." something else"
+	endcase
+	cr
+	;
+
+
+see test-case-2
+
+cr
+
+.( You should once more see [3] 1 2 3 -> )
+.s-simple
+.( <-) cr
+
+.( You should see "zeroone": )
+0 test-case-2
+
+.( You should see "one": )
+1 test-case-2
+
+.( You should see "two": )
+2 test-case-2
+
+.( You should see "something else": )
+324 test-case-2
+
+.( You should still see [3] 1 2 3 -> )
+.s-simple
+.( <-) cr
+
+
+
+bye
diff --git a/usr/src/common/ficl/test/tester.fr b/usr/src/common/ficl/test/tester.fr
new file mode 100644
index 0000000000..d36a5f43d6
--- /dev/null
+++ b/usr/src/common/ficl/test/tester.fr
@@ -0,0 +1,58 @@
+\ From: John Hayes S1I
+\ Subject: tester.fr
+\ Date: Mon, 27 Nov 95 13:10:09 PST
+\ john.hayes@jhuapl.edu
+\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
+\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
+\ VERSION 1.1
+
+\ jws notes: <> is a core ext word
+
+HEX
+
+\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
+\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.
+VARIABLE VERBOSE
+   TRUE VERBOSE !
+
+: EMPTY-STACK	\ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.
+   DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ;
+
+: ERROR		\ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
+		\ THE LINE THAT HAD THE ERROR.
+   TYPE SOURCE TYPE CR			\ DISPLAY LINE CORRESPONDING TO ERROR
+   EMPTY-STACK				\ THROW AWAY EVERY THING ELSE
+   break	\ jws
+;
+
+VARIABLE ACTUAL-DEPTH			\ STACK RECORD
+
+CREATE ACTUAL-RESULTS 20 CELLS ALLOT
+
+: {		\ ( -- ) SYNTACTIC SUGAR.
+   ;
+
+: ->		\ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
+   DEPTH DUP ACTUAL-DEPTH !		\ RECORD DEPTH
+   ?DUP IF				\ IF THERE IS SOMETHING ON STACK
+      0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
+   THEN ;
+
+: }		\ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
+		\ (ACTUAL) CONTENTS.
+   DEPTH ACTUAL-DEPTH @ = IF		\ IF DEPTHS MATCH
+      DEPTH ?DUP IF			\ IF THERE IS SOMETHING ON THE STACK
+         0 DO				\ FOR EACH STACK ITEM
+	    ACTUAL-RESULTS I CELLS + @	\ COMPARE ACTUAL WITH EXPECTED
+	    <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN
+	 LOOP
+      THEN
+   ELSE					\ DEPTH MISMATCH
+      S" WRONG NUMBER OF RESULTS: " ERROR
+   THEN ;
+
+: TESTING	\ ( -- ) TALKING COMMENT.
+   SOURCE VERBOSE @
+   IF DUP >R TYPE CR R> >IN !
+   ELSE >IN ! DROP
+   THEN ;
diff --git a/usr/src/common/ficl/test/vocab.fr b/usr/src/common/ficl/test/vocab.fr
new file mode 100644
index 0000000000..bb245eb2ea
--- /dev/null
+++ b/usr/src/common/ficl/test/vocab.fr
@@ -0,0 +1,32 @@
+\ Here is an implementation of ALSO/ONLY in terms of the
+\ primitive search-order word set.
+\
+WORDLIST CONSTANT ROOT   ROOT SET-CURRENT
+
+: DO-VOCABULARY  ( -- ) \ Implementation factor
+    DOES>  @ >R           (  ) ( R: widnew )
+     GET-ORDER  SWAP DROP ( wid1 ... widn-1 n )
+     R> SWAP SET-ORDER
+;
+
+: DISCARD  ( x1 .. xu u - ) \ Implementation factor
+   0 ?DO DROP LOOP          \ DROP u+1 stack items
+;
+
+CREATE FORTH  FORTH-WORDLIST , DO-VOCABULARY
+
+: VOCABULARY  ( name -- )  WORDLIST CREATE ,  DO-VOCABULARY ;
+
+: ALSO  ( -- )  GET-ORDER  OVER SWAP 1+ SET-ORDER ;
+
+: PREVIOUS  ( --  )  GET-ORDER  SWAP DROP 1- SET-ORDER ;
+
+: DEFINITIONS  ( -- )  GET-ORDER  OVER SET-CURRENT DISCARD ;
+
+: ONLY ( -- )  ROOT ROOT  2 SET-ORDER ;
+
+\ Forth-83 version; just removes ONLY
+: SEAL  ( -- )  GET-ORDER 1- SET-ORDER DROP ;
+
+\ F83 and F-PC version; leaves only CONTEXT
+: SEAL  ( -- )  GET-ORDER OVER 1 SET-ORDER DISCARD ;
diff --git a/usr/src/common/ficl/tools.c b/usr/src/common/ficl/tools.c
new file mode 100644
index 0000000000..39759b388a
--- /dev/null
+++ b/usr/src/common/ficl/tools.c
@@ -0,0 +1,949 @@
+/*
+ * t o o l s . c
+ * Forth Inspired Command Language - programming tools
+ * Author: John Sadler (john_sadler@alum.mit.edu)
+ * Created: 20 June 2000
+ * $Id: tools.c,v 1.12 2010/08/12 13:57:22 asau 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.
+ */
+
+/*
+ * 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.
+ * fiColonParen fiDoDoes createParen fiVariableParen fiUserParen fiConstantParen
+ *
+ * Step and break debugger for Ficl
+ * debug  ( xt -- )   Start debugging an xt
+ * Set a breakpoint
+ * Specify breakpoint default action
+ */
+
+#include "ficl.h"
+
+extern void exit(int);
+
+static void ficlPrimitiveStepIn(ficlVm *vm);
+static void ficlPrimitiveStepOver(ficlVm *vm);
+static void ficlPrimitiveStepBreak(ficlVm *vm);
+
+void
+ficlCallbackAssert(ficlCallback *callback, int expression,
+    char *expressionString, char *filename, int line)
+{
+#if FICL_ROBUST >= 1
+	if (!expression) {
+		static char buffer[256];
+		sprintf(buffer, "ASSERTION FAILED at %s:%d: \"%s\"\n",
+		    filename, line, expressionString);
+		ficlCallbackTextOut(callback, buffer);
+		exit(-1);
+	}
+#else /* FICL_ROBUST >= 1 */
+	FICL_IGNORE(callback);
+	FICL_IGNORE(expression);
+	FICL_IGNORE(expressionString);
+	FICL_IGNORE(filename);
+	FICL_IGNORE(line);
+#endif /* FICL_ROBUST >= 1 */
+}
+
+/*
+ * 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
+ficlVmSetBreak(ficlVm *vm, ficlBreakpoint *pBP)
+{
+	ficlWord *pStep = ficlSystemLookup(vm->callback.system, "step-break");
+	FICL_VM_ASSERT(vm, pStep);
+
+	pBP->address = vm->ip;
+	pBP->oldXT = *vm->ip;
+	*vm->ip = pStep;
+}
+
+/*
+ * d e b u g P r o m p t
+ */
+static void
+ficlDebugPrompt(ficlVm *vm, int debug)
+{
+	if (debug)
+		setenv("prompt", "dbg> ", 1);
+	else
+		setenv("prompt", "${interpret}", 1);
+}
+
+#if 0
+static int
+isPrimitive(ficlWord *word)
+{
+	ficlWordKind wk = ficlWordClassify(word);
+	return ((wk != COLON) && (wk != DOES));
+}
+#endif
+
+/*
+ * 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
+ficlPrimitiveHashSummary(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlHash *pFHash;
+	ficlWord **hash;
+	unsigned size;
+	ficlWord *word;
+	unsigned i;
+	int nMax = 0;
+	int nWords = 0;
+	int nFilled;
+	double avg = 0.0;
+	double best;
+	int nAvg, nRem, nDepth;
+
+	FICL_VM_DICTIONARY_CHECK(vm, dictionary, 0);
+
+	pFHash = dictionary->wordlists[dictionary->wordlistCount - 1];
+	hash = pFHash->table;
+	size = pFHash->size;
+	nFilled = size;
+
+	for (i = 0; i < size; i++) {
+		int n = 0;
+		word = hash[i];
+
+		while (word) {
+			++n;
+			++nWords;
+			word = word->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(vm->pad, "%d bins, %2.0f%% filled, Depth: "
+	    "Max=%d, Avg=%2.1f, Best=%2.1f, Score: %2.0f%%\n",
+	    size, (double)nFilled * 100.0 / size, nMax,
+	    avg, best, 100.0 * best / avg);
+
+	ficlVmTextOut(vm, vm->pad);
+}
+#endif
+
+/*
+ * Here's the outer part of the decompiler. It's
+ * just a big nested conditional that checks the
+ * CFA of the word to decompile for each kind of
+ * known word-builder code, and tries to do
+ * something appropriate. If the CFA is not recognized,
+ * just indicate that it is a primitive.
+ */
+static void
+ficlPrimitiveSeeXT(ficlVm *vm)
+{
+	ficlWord *word;
+	ficlWordKind kind;
+
+	word = (ficlWord *)ficlStackPopPointer(vm->dataStack);
+	kind = ficlWordClassify(word);
+
+	switch (kind) {
+	case FICL_WORDKIND_COLON:
+		sprintf(vm->pad, ": %.*s\n", word->length, word->name);
+		ficlVmTextOut(vm, vm->pad);
+		ficlDictionarySee(ficlVmGetDictionary(vm), word,
+		    &(vm->callback));
+	break;
+	case FICL_WORDKIND_DOES:
+		ficlVmTextOut(vm, "does>\n");
+		ficlDictionarySee(ficlVmGetDictionary(vm),
+		    (ficlWord *)word->param->p, &(vm->callback));
+	break;
+	case FICL_WORDKIND_CREATE:
+		ficlVmTextOut(vm, "create\n");
+	break;
+	case FICL_WORDKIND_VARIABLE:
+		sprintf(vm->pad, "variable = %ld (%#lx)\n",
+		    (long)word->param->i, (long unsigned)word->param->u);
+		ficlVmTextOut(vm, vm->pad);
+	break;
+#if FICL_WANT_USER
+	case FICL_WORDKIND_USER:
+		sprintf(vm->pad, "user variable %ld (%#lx)\n",
+		    (long)word->param->i, (long unsigned)word->param->u);
+		ficlVmTextOut(vm, vm->pad);
+	break;
+#endif
+	case FICL_WORDKIND_CONSTANT:
+		sprintf(vm->pad, "constant = %ld (%#lx)\n",
+		    (long)word->param->i, (long unsigned)word->param->u);
+		ficlVmTextOut(vm, vm->pad);
+	break;
+	case FICL_WORDKIND_2CONSTANT:
+		sprintf(vm->pad, "constant = %ld %ld (%#lx %#lx)\n",
+		    (long)word->param[1].i, (long)word->param->i,
+		    (long unsigned)word->param[1].u,
+		    (long unsigned)word->param->u);
+		ficlVmTextOut(vm, vm->pad);
+	break;
+
+	default:
+		sprintf(vm->pad, "%.*s is a primitive\n", word->length,
+		    word->name);
+		ficlVmTextOut(vm, vm->pad);
+	break;
+	}
+
+	if (word->flags & FICL_WORD_IMMEDIATE) {
+		ficlVmTextOut(vm, "immediate\n");
+	}
+
+	if (word->flags & FICL_WORD_COMPILE_ONLY) {
+		ficlVmTextOut(vm, "compile-only\n");
+	}
+}
+
+static void
+ficlPrimitiveSee(ficlVm *vm)
+{
+	ficlPrimitiveTick(vm);
+	ficlPrimitiveSeeXT(vm);
+}
+
+/*
+ * f i c l D e b u g X T
+ * debug  ( xt -- )
+ * Given an xt of a colon definition or a word defined by DOES>, set the
+ * VM up to debug the word: push IP, set the xt as the next thing to execute,
+ * set a breakpoint at its first instruction, and run to the breakpoint.
+ * Note: the semantics of this word are equivalent to "step in"
+ */
+static void
+ficlPrimitiveDebugXT(ficlVm *vm)
+{
+	ficlWord *xt = ficlStackPopPointer(vm->dataStack);
+	ficlWordKind wk = ficlWordClassify(xt);
+
+	ficlStackPushPointer(vm->dataStack, xt);
+	ficlPrimitiveSeeXT(vm);
+
+	switch (wk) {
+	case FICL_WORDKIND_COLON:
+	case FICL_WORDKIND_DOES:
+		/*
+		 * Run the colon code and set a breakpoint at the next
+		 * instruction
+		 */
+		ficlVmExecuteWord(vm, xt);
+		ficlVmSetBreak(vm, &(vm->callback.system->breakpoint));
+	break;
+	default:
+		ficlVmExecuteWord(vm, xt);
+	break;
+	}
+}
+
+/*
+ * s t e p I n
+ * Ficl
+ * Execute the next instruction, stepping into it if it's a colon definition
+ * or a does> word. This is the easy kind of step.
+ */
+static void
+ficlPrimitiveStepIn(ficlVm *vm)
+{
+	/*
+	 * Do one step of the inner loop
+	 */
+	ficlVmExecuteWord(vm, *vm->ip++);
+
+	/*
+	 * Now set a breakpoint at the next instruction
+	 */
+	ficlVmSetBreak(vm, &(vm->callback.system->breakpoint));
+}
+
+/*
+ * s t e p O v e r
+ * Ficl
+ * Execute the next instruction atomically. This requires some insight into
+ * the memory layout of compiled code. Set a breakpoint at the next instruction
+ * in this word, and run until we hit it
+ */
+static void
+ficlPrimitiveStepOver(ficlVm *vm)
+{
+	ficlWord *word;
+	ficlWordKind kind;
+	ficlWord *pStep = ficlSystemLookup(vm->callback.system, "step-break");
+	FICL_VM_ASSERT(vm, pStep);
+
+	word = *vm->ip;
+	kind = ficlWordClassify(word);
+
+	switch (kind) {
+	case FICL_WORDKIND_COLON:
+	case FICL_WORDKIND_DOES:
+		/*
+		 * assume that the next ficlCell holds an instruction
+		 * set a breakpoint there and return to the inner interpreter
+		 */
+		vm->callback.system->breakpoint.address = vm->ip + 1;
+		vm->callback.system->breakpoint.oldXT =  vm->ip[1];
+		vm->ip[1] = pStep;
+	break;
+	default:
+		ficlPrimitiveStepIn(vm);
+	break;
+	}
+}
+
+/*
+ * s t e p - b r e a k
+ * Ficl
+ * Handles breakpoints for stepped execution.
+ * Upon entry, breakpoint contains the address and replaced instruction
+ * of the current breakpoint.
+ * Clear the breakpoint
+ * Get a command from the console.
+ * i (step in) - execute the current instruction and set a new breakpoint
+ *    at the IP
+ * o (step over) - execute the current instruction to completion and set
+ *    a new breakpoint at the IP
+ * g (go) - execute the current instruction and exit
+ * q (quit) - abort current word
+ * b (toggle breakpoint)
+ */
+
+extern char *ficlDictionaryInstructionNames[];
+
+static void
+ficlPrimitiveStepBreak(ficlVm *vm)
+{
+	ficlString command;
+	ficlWord *word;
+	ficlWord *pOnStep;
+	int debug = 1;
+
+	if (!vm->restart) {
+		FICL_VM_ASSERT(vm, vm->callback.system->breakpoint.address);
+		FICL_VM_ASSERT(vm, vm->callback.system->breakpoint.oldXT);
+
+		/*
+		 * Clear the breakpoint that caused me to run
+		 * Restore the original instruction at the breakpoint,
+		 * and restore the IP
+		 */
+		vm->ip = (ficlIp)(vm->callback.system->breakpoint.address);
+		*vm->ip = vm->callback.system->breakpoint.oldXT;
+
+		/*
+		 * If there's an onStep, do it
+		 */
+		pOnStep = ficlSystemLookup(vm->callback.system, "on-step");
+		if (pOnStep)
+			ficlVmExecuteXT(vm, pOnStep);
+
+		/*
+		 * Print the name of the next instruction
+		 */
+		word = vm->callback.system->breakpoint.oldXT;
+
+		if ((((ficlInstruction)word) > ficlInstructionInvalid) &&
+		    (((ficlInstruction)word) < ficlInstructionLast))
+			sprintf(vm->pad, "next: %s (instruction %ld)\n",
+			    ficlDictionaryInstructionNames[(long)word],
+			    (long)word);
+		else {
+			sprintf(vm->pad, "next: %s\n", word->name);
+			if (strcmp(word->name, "interpret") == 0)
+				debug = 0;
+		}
+
+		ficlVmTextOut(vm, vm->pad);
+		ficlDebugPrompt(vm, debug);
+	} else {
+		vm->restart = 0;
+	}
+
+	command = ficlVmGetWord(vm);
+
+	switch (command.text[0]) {
+		case 'i':
+			ficlPrimitiveStepIn(vm);
+		break;
+
+		case 'o':
+			ficlPrimitiveStepOver(vm);
+		break;
+
+		case 'g':
+		break;
+
+		case 'l': {
+			ficlWord *xt;
+			xt = ficlDictionaryFindEnclosingWord(
+			    ficlVmGetDictionary(vm), (ficlCell *)(vm->ip));
+			if (xt) {
+				ficlStackPushPointer(vm->dataStack, xt);
+				ficlPrimitiveSeeXT(vm);
+			} else {
+				ficlVmTextOut(vm, "sorry - can't do that\n");
+			}
+			ficlVmThrow(vm, FICL_VM_STATUS_RESTART);
+		break;
+		}
+
+		case 'q':
+			ficlDebugPrompt(vm, 0);
+			ficlVmThrow(vm, FICL_VM_STATUS_ABORT);
+			break;
+		case 'x': {
+			/*
+			 * Take whatever's left in the TIB and feed it to a
+			 * subordinate ficlVmExecuteString
+			 */
+			int returnValue;
+			ficlString s;
+			ficlWord *oldRunningWord = vm->runningWord;
+
+			FICL_STRING_SET_POINTER(s,
+			    vm->tib.text + vm->tib.index);
+			FICL_STRING_SET_LENGTH(s,
+			    vm->tib.end - FICL_STRING_GET_POINTER(s));
+
+			returnValue = ficlVmExecuteString(vm, s);
+
+			if (returnValue == FICL_VM_STATUS_OUT_OF_TEXT) {
+				returnValue = FICL_VM_STATUS_RESTART;
+				vm->runningWord = oldRunningWord;
+				ficlVmTextOut(vm, "\n");
+			}
+			if (returnValue == FICL_VM_STATUS_ERROR_EXIT)
+				ficlDebugPrompt(vm, 0);
+
+			ficlVmThrow(vm, returnValue);
+			break;
+		}
+
+		default:
+			ficlVmTextOut(vm,
+			    "i -- step In\n"
+			    "o -- step Over\n"
+			    "g -- Go (execute to completion)\n"
+			    "l -- List source code\n"
+			    "q -- Quit (stop debugging and abort)\n"
+			    "x -- eXecute the rest of the line "
+			    "as Ficl words\n");
+			ficlDebugPrompt(vm, 1);
+			ficlVmThrow(vm, FICL_VM_STATUS_RESTART);
+		break;
+	}
+
+	ficlDebugPrompt(vm, 0);
+}
+
+/*
+ * b y e
+ * TOOLS
+ * Signal the system to shut down - this causes ficlExec to return
+ * VM_USEREXIT. The rest is up to you.
+ */
+static void
+ficlPrimitiveBye(ficlVm *vm)
+{
+	ficlVmThrow(vm, FICL_VM_STATUS_USER_EXIT);
+}
+
+/*
+ * d i s p l a y S t a c k
+ * TOOLS
+ * Display the parameter stack (code for ".s")
+ */
+
+struct stackContext
+{
+	ficlVm *vm;
+	ficlDictionary *dictionary;
+	int count;
+};
+
+static ficlInteger
+ficlStackDisplayCallback(void *c, ficlCell *cell)
+{
+	struct stackContext *context = (struct stackContext *)c;
+	char buffer[80];
+
+#ifdef _LP64
+	snprintf(buffer, sizeof (buffer), "[0x%016lx %3d]: %20ld (0x%016lx)\n",
+	    (unsigned long)cell, context->count++, (long)cell->i,
+	    (unsigned long)cell->u);
+#else
+	snprintf(buffer, sizeof (buffer), "[0x%08x %3d]: %12d (0x%08x)\n",
+	    (unsigned)cell, context->count++, cell->i, cell->u);
+#endif
+
+	ficlVmTextOut(context->vm, buffer);
+	return (FICL_TRUE);
+}
+
+void
+ficlStackDisplay(ficlStack *stack, ficlStackWalkFunction callback,
+    void *context)
+{
+	ficlVm *vm = stack->vm;
+	char buffer[128];
+	struct stackContext myContext;
+
+	FICL_STACK_CHECK(stack, 0, 0);
+
+#ifdef _LP64
+	sprintf(buffer, "[%s stack has %d entries, top at 0x%016lx]\n",
+	    stack->name, ficlStackDepth(stack), (unsigned long)stack->top);
+#else
+	sprintf(buffer, "[%s stack has %d entries, top at 0x%08x]\n",
+	    stack->name, ficlStackDepth(stack), (unsigned)stack->top);
+#endif
+	ficlVmTextOut(vm, buffer);
+
+	if (callback == NULL) {
+		myContext.vm = vm;
+		myContext.count = 0;
+		context = &myContext;
+		callback = ficlStackDisplayCallback;
+	}
+	ficlStackWalk(stack, callback, context, FICL_FALSE);
+
+#ifdef _LP64
+	sprintf(buffer, "[%s stack base at 0x%016lx]\n", stack->name,
+	    (unsigned long)stack->base);
+#else
+	sprintf(buffer, "[%s stack base at 0x%08x]\n", stack->name,
+	    (unsigned)stack->base);
+#endif
+	ficlVmTextOut(vm, buffer);
+}
+
+void
+ficlVmDisplayDataStack(ficlVm *vm)
+{
+	ficlStackDisplay(vm->dataStack, NULL, NULL);
+}
+
+static ficlInteger
+ficlStackDisplaySimpleCallback(void *c, ficlCell *cell)
+{
+	struct stackContext *context = (struct stackContext *)c;
+	char buffer[32];
+
+	sprintf(buffer, "%s%ld", context->count ? " " : "", (long)cell->i);
+	context->count++;
+	ficlVmTextOut(context->vm, buffer);
+	return (FICL_TRUE);
+}
+
+void
+ficlVmDisplayDataStackSimple(ficlVm *vm)
+{
+	ficlStack *stack = vm->dataStack;
+	char buffer[32];
+	struct stackContext context;
+
+	FICL_STACK_CHECK(stack, 0, 0);
+
+	sprintf(buffer, "[%d] ", ficlStackDepth(stack));
+	ficlVmTextOut(vm, buffer);
+
+	context.vm = vm;
+	context.count = 0;
+	ficlStackWalk(stack, ficlStackDisplaySimpleCallback, &context,
+	    FICL_TRUE);
+}
+
+static ficlInteger
+ficlReturnStackDisplayCallback(void *c, ficlCell *cell)
+{
+	struct stackContext *context = (struct stackContext *)c;
+	char buffer[128];
+
+#ifdef _LP64
+	sprintf(buffer, "[0x%016lx %3d] %20ld (0x%016lx)", (unsigned long)cell,
+	    context->count++, cell->i, cell->u);
+#else
+	sprintf(buffer, "[0x%08x %3d] %12d (0x%08x)", (unsigned)cell,
+	    context->count++, cell->i, cell->u);
+#endif
+
+	/*
+	 * Attempt to find the word that contains the return
+	 * stack address (as if it is part of a colon definition).
+	 * If this works, also print the name of the word.
+	 */
+	if (ficlDictionaryIncludes(context->dictionary, cell->p)) {
+		ficlWord *word;
+		word = ficlDictionaryFindEnclosingWord(context->dictionary,
+		    cell->p);
+		if (word) {
+			int offset = (ficlCell *)cell->p - &word->param[0];
+			sprintf(buffer + strlen(buffer), ", %s + %d ",
+			    word->name, offset);
+		}
+	}
+	strcat(buffer, "\n");
+	ficlVmTextOut(context->vm, buffer);
+	return (FICL_TRUE);
+}
+
+void
+ficlVmDisplayReturnStack(ficlVm *vm)
+{
+	struct stackContext context;
+	context.vm = vm;
+	context.count = 0;
+	context.dictionary = ficlVmGetDictionary(vm);
+	ficlStackDisplay(vm->returnStack, ficlReturnStackDisplayCallback,
+	    &context);
+}
+
+/*
+ * f o r g e t - w i d
+ */
+static void
+ficlPrimitiveForgetWid(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlHash *hash;
+
+	hash = (ficlHash *)ficlStackPopPointer(vm->dataStack);
+	ficlHashForget(hash, dictionary->here);
+}
+
+/*
+ * f o r g e t
+ * TOOLS EXT  ( "<spaces>name" -- )
+ * Skip leading space delimiters. Parse name delimited by a space.
+ * Find name, then delete name from the dictionary along with all
+ * words added to the dictionary after name. An ambiguous
+ * condition exists if name cannot be found.
+ *
+ * If the Search-Order word set is present, FORGET searches the
+ * compilation word list. An ambiguous condition exists if the
+ * compilation word list is deleted.
+ */
+static void
+ficlPrimitiveForget(ficlVm *vm)
+{
+	void *where;
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlHash *hash = dictionary->compilationWordlist;
+
+	ficlPrimitiveTick(vm);
+	where = ((ficlWord *)ficlStackPopPointer(vm->dataStack))->name;
+	ficlHashForget(hash, where);
+	dictionary->here = FICL_POINTER_TO_CELL(where);
+}
+
+/*
+ * w o r d s
+ */
+#define	nCOLWIDTH	8
+
+static void
+ficlPrimitiveWords(ficlVm *vm)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlHash *hash = dictionary->wordlists[dictionary->wordlistCount - 1];
+	ficlWord *wp;
+	int nChars = 0;
+	int len;
+	unsigned i;
+	int nWords = 0;
+	char *cp;
+	char *pPad;
+	int columns;
+
+	cp = getenv("COLUMNS");
+	/*
+	 * using strtol for now. TODO: refactor number conversion from
+	 * ficlPrimitiveToNumber() and use it instead.
+	 */
+	if (cp == NULL)
+		columns = 80;
+	else
+		columns = strtol(cp, NULL, 0);
+
+	/*
+	 * the pad is fixed size area, it's better to allocate
+	 * dedicated buffer space to deal with custom terminal sizes.
+	 */
+	pPad = malloc(columns + 1);
+	if (pPad == NULL)
+		ficlVmThrowError(vm, "Error: out of memory");
+
+	pager_open();
+	for (i = 0; i < hash->size; i++) {
+		for (wp = hash->table[i]; wp != NULL; wp = wp->link, nWords++) {
+			if (wp->length == 0) /* ignore :noname defs */
+				continue;
+
+			/* prevent line wrap due to long words */
+			if (nChars + wp->length >= columns) {
+				pPad[nChars++] = '\n';
+				pPad[nChars] = '\0';
+				nChars = 0;
+				if (pager_output(pPad))
+					goto pager_done;
+			}
+
+			cp = wp->name;
+			nChars += sprintf(pPad + nChars, "%s", cp);
+
+			if (nChars > columns - 10) {
+				pPad[nChars++] = '\n';
+				pPad[nChars] = '\0';
+				nChars = 0;
+				if (pager_output(pPad))
+					goto pager_done;
+			} else {
+				len = nCOLWIDTH - nChars % nCOLWIDTH;
+				while (len-- > 0)
+					pPad[nChars++] = ' ';
+			}
+
+			if (nChars > columns - 10) {
+				pPad[nChars++] = '\n';
+				pPad[nChars] = '\0';
+				nChars = 0;
+				if (pager_output(pPad))
+					goto pager_done;
+			}
+		}
+	}
+
+	if (nChars > 0) {
+		pPad[nChars++] = '\n';
+		pPad[nChars] = '\0';
+		nChars = 0;
+		ficlVmTextOut(vm, pPad);
+	}
+
+	sprintf(pPad, "Dictionary: %d words, %ld cells used of %u total\n",
+	    nWords, (long)(dictionary->here - dictionary->base),
+	    dictionary->size);
+	pager_output(pPad);
+
+pager_done:
+	free(pPad);
+	pager_close();
+}
+
+/*
+ * l i s t E n v
+ * Print symbols defined in the environment
+ */
+static void
+ficlPrimitiveListEnv(ficlVm *vm)
+{
+	ficlDictionary *dictionary = vm->callback.system->environment;
+	ficlHash *hash = dictionary->forthWordlist;
+	ficlWord *word;
+	unsigned i;
+	int counter = 0;
+
+	pager_open();
+	for (i = 0; i < hash->size; i++) {
+		for (word = hash->table[i]; word != NULL;
+		    word = word->link, counter++) {
+			sprintf(vm->pad, "%s\n", word->name);
+			if (pager_output(vm->pad))
+				goto pager_done;
+		}
+	}
+
+	sprintf(vm->pad, "Environment: %d words, %ld cells used of %u total\n",
+	    counter, (long)(dictionary->here - dictionary->base),
+	    dictionary->size);
+	pager_output(vm->pad);
+
+pager_done:
+	pager_close();
+}
+
+/*
+ * This word lists the parse steps in order
+ */
+void
+ficlPrimitiveParseStepList(ficlVm *vm)
+{
+	int i;
+	ficlSystem *system = vm->callback.system;
+	FICL_VM_ASSERT(vm, system);
+
+	ficlVmTextOut(vm, "Parse steps:\n");
+	ficlVmTextOut(vm, "lookup\n");
+
+	for (i = 0; i < FICL_MAX_PARSE_STEPS; i++) {
+		if (system->parseList[i] != NULL) {
+			ficlVmTextOut(vm, system->parseList[i]->name);
+			ficlVmTextOut(vm, "\n");
+		} else
+			break;
+	}
+}
+
+/*
+ * e n v C o n s t a n t
+ * Ficl interface to ficlSystemSetEnvironment and ficlSetEnvD - allow Ficl
+ * code to set environment constants...
+ */
+static void
+ficlPrimitiveEnvConstant(ficlVm *vm)
+{
+	unsigned value;
+	FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+	ficlVmGetWordToPad(vm);
+	value = ficlStackPopUnsigned(vm->dataStack);
+	ficlDictionarySetConstant(ficlSystemGetEnvironment(vm->callback.system),
+	    vm->pad, (ficlUnsigned)value);
+}
+
+static void
+ficlPrimitiveEnv2Constant(ficlVm *vm)
+{
+	ficl2Integer value;
+
+	FICL_STACK_CHECK(vm->dataStack, 2, 0);
+
+	ficlVmGetWordToPad(vm);
+	value = ficlStackPop2Integer(vm->dataStack);
+	ficlDictionarySet2Constant(
+	    ficlSystemGetEnvironment(vm->callback.system), vm->pad, value);
+}
+
+
+/*
+ * f i c l C o m p i l e T o o l s
+ * Builds wordset for debugger and TOOLS optional word set
+ */
+void
+ficlSystemCompileTools(ficlSystem *system)
+{
+	ficlDictionary *dictionary = ficlSystemGetDictionary(system);
+	ficlDictionary *environment = ficlSystemGetEnvironment(system);
+
+	FICL_SYSTEM_ASSERT(system, dictionary);
+	FICL_SYSTEM_ASSERT(system, environment);
+
+
+	/*
+	 * TOOLS and TOOLS EXT
+	 */
+	ficlDictionarySetPrimitive(dictionary, ".s", ficlVmDisplayDataStack,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, ".s-simple",
+	    ficlVmDisplayDataStackSimple,  FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "bye", ficlPrimitiveBye,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "forget", ficlPrimitiveForget,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "see", ficlPrimitiveSee,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "words", ficlPrimitiveWords,
+	    FICL_WORD_DEFAULT);
+
+	/*
+	 * Set TOOLS environment query values
+	 */
+	ficlDictionarySetConstant(environment, "tools", FICL_TRUE);
+	ficlDictionarySetConstant(environment, "tools-ext", FICL_FALSE);
+
+	/*
+	 * Ficl extras
+	 */
+	ficlDictionarySetPrimitive(dictionary, "r.s", ficlVmDisplayReturnStack,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, ".env", ficlPrimitiveListEnv,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "env-constant",
+	    ficlPrimitiveEnvConstant, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "env-2constant",
+	    ficlPrimitiveEnv2Constant, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "debug-xt", ficlPrimitiveDebugXT,
+	    FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "parse-order",
+	    ficlPrimitiveParseStepList, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "step-break",
+	    ficlPrimitiveStepBreak, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "forget-wid",
+	    ficlPrimitiveForgetWid, FICL_WORD_DEFAULT);
+	ficlDictionarySetPrimitive(dictionary, "see-xt", ficlPrimitiveSeeXT,
+	    FICL_WORD_DEFAULT);
+
+#if FICL_WANT_FLOAT
+	ficlDictionarySetPrimitive(dictionary, ".hash",
+	    ficlPrimitiveHashSummary, FICL_WORD_DEFAULT);
+#endif
+}
diff --git a/usr/src/common/ficl/utility.c b/usr/src/common/ficl/utility.c
new file mode 100644
index 0000000000..3e140a6075
--- /dev/null
+++ b/usr/src/common/ficl/utility.c
@@ -0,0 +1,241 @@
+#include "ficl.h"
+
+/*
+ * a l i g n P t r
+ * Aligns the given pointer to FICL_ALIGN address units.
+ * Returns the aligned pointer value.
+ */
+void *
+ficlAlignPointer(void *ptr)
+{
+#if FICL_PLATFORM_ALIGNMENT > 1
+	intptr_t p = (intptr_t)ptr;
+
+	if (p & (FICL_PLATFORM_ALIGNMENT - 1))
+		ptr = (void *)((p & ~(FICL_PLATFORM_ALIGNMENT - 1)) +
+		    FICL_PLATFORM_ALIGNMENT);
+#endif
+	return (ptr);
+}
+
+/*
+ * s t r r e v
+ */
+char *
+ficlStringReverse(char *string)
+{
+	int i = strlen(string);
+	char *p1 = string;		/* first char of string */
+	char *p2 = string + i - 1;	/* last non-NULL char of string */
+	char c;
+
+	if (i > 1) {
+		while (p1 < p2) {
+			c = *p2;
+			*p2 = *p1;
+			*p1 = c;
+			p1++; p2--;
+		}
+	}
+
+	return (string);
+}
+
+/*
+ * d i g i t _ t o _ c h a r
+ */
+static char digits[] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+char
+ficlDigitToCharacter(int value)
+{
+	return (digits[value]);
+}
+
+/*
+ * i s P o w e r O f T w o
+ * Tests whether supplied argument is an integer power of 2 (2**n)
+ * where 32 > n > 1, and returns n if so. Otherwise returns zero.
+ */
+int
+ficlIsPowerOfTwo(ficlUnsigned u)
+{
+	int i = 1;
+	ficlUnsigned t = 2;
+
+	for (; ((t <= u) && (t != 0)); i++, t <<= 1) {
+		if (u == t)
+			return (i);
+	}
+
+	return (0);
+}
+
+/*
+ * l t o a
+ */
+char *
+ficlLtoa(ficlInteger value, char *string, int radix)
+{
+	char *cp = string;
+	int sign = ((radix == 10) && (value < 0));
+	int pwr;
+
+	FICL_ASSERT(NULL, radix > 1);
+	FICL_ASSERT(NULL, radix < 37);
+	FICL_ASSERT(NULL, string);
+
+	pwr = ficlIsPowerOfTwo((ficlUnsigned)radix);
+
+	if (sign)
+		value = -value;
+
+	if (value == 0)
+		*cp++ = '0';
+	else if (pwr != 0) {
+		ficlUnsigned v = (ficlUnsigned) value;
+		ficlUnsigned mask = (ficlUnsigned) ~(-1 << pwr);
+		while (v) {
+			*cp++ = digits[v & mask];
+			v >>= pwr;
+		}
+	} else {
+		ficl2UnsignedQR result;
+		ficl2Unsigned v;
+		FICL_UNSIGNED_TO_2UNSIGNED((ficlUnsigned)value, v);
+		while (FICL_2UNSIGNED_NOT_ZERO(v)) {
+			result = ficl2UnsignedDivide(v, (ficlUnsigned)radix);
+			*cp++ = digits[result.remainder];
+			v = result.quotient;
+		}
+	}
+
+	if (sign)
+		*cp++ = '-';
+
+	*cp++ = '\0';
+
+	return (ficlStringReverse(string));
+}
+
+/*
+ * u l t o a
+ */
+char *
+ficlUltoa(ficlUnsigned value, char *string, int radix)
+{
+	char *cp = string;
+	ficl2Unsigned ud;
+	ficl2UnsignedQR result;
+
+	FICL_ASSERT(NULL, radix > 1);
+	FICL_ASSERT(NULL, radix < 37);
+	FICL_ASSERT(NULL, string);
+
+	if (value == 0)
+		*cp++ = '0';
+	else {
+		FICL_UNSIGNED_TO_2UNSIGNED(value, ud);
+		while (FICL_2UNSIGNED_NOT_ZERO(ud)) {
+			result = ficl2UnsignedDivide(ud, (ficlUnsigned)radix);
+			ud = result.quotient;
+			*cp++ = digits[result.remainder];
+		}
+	}
+
+	*cp++ = '\0';
+
+	return (ficlStringReverse(string));
+}
+
+/*
+ * c a s e F o l d
+ * Case folds a NULL terminated string in place. All characters
+ * get converted to lower case.
+ */
+char *
+ficlStringCaseFold(char *cp)
+{
+	char *oldCp = cp;
+
+	while (*cp) {
+		if (isupper((unsigned char)*cp))
+			*cp = (char)tolower((unsigned char)*cp);
+		cp++;
+	}
+
+	return (oldCp);
+}
+
+/*
+ * s t r i n c m p
+ * (jws) simplified the code a bit in hopes of appeasing Purify
+ */
+int
+ficlStrincmp(char *cp1, char *cp2, ficlUnsigned count)
+{
+	int i = 0;
+
+	for (; 0 < count; ++cp1, ++cp2, --count) {
+		i = tolower((unsigned char)*cp1) - tolower((unsigned char)*cp2);
+		if (i != 0)
+			return (i);
+		else if (*cp1 == '\0')
+			return (0);
+	}
+	return (0);
+}
+
+/*
+ * s k i p S p a c e
+ * Given a string pointer, returns a pointer to the first non-space
+ * char of the string, or to the NULL terminator if no such char found.
+ * If the pointer reaches "end" first, stop there. Pass NULL to
+ * suppress this behavior.
+ */
+char *
+ficlStringSkipSpace(char *cp, char *end)
+{
+	FICL_ASSERT(NULL, cp);
+
+	while ((cp != end) && isspace((unsigned char)*cp))
+		cp++;
+
+	return (cp);
+}
+
+void
+ficlCompatibilityTextOutCallback(ficlCallback *callback, char *text,
+    ficlCompatibilityOutputFunction outputFunction)
+{
+	char buffer[256];
+	char *bufferStop = buffer + sizeof (buffer) - 1;
+
+	if (text == NULL) {
+		outputFunction(callback->vm, NULL, 0 /* false */);
+		return;
+	}
+
+	while (*text) {
+		int newline = 0 /* false */;
+		char *trace = buffer;
+		while ((*text) && (trace < bufferStop)) {
+			switch (*text) {
+			/* throw away \r */
+			case '\r':
+				text++;
+			continue;
+			case '\n':
+				text++;
+				newline = !0 /* true */;
+			break;
+			default:
+				*trace++ = *text++;
+			break;
+			}
+		}
+
+		*trace = 0;
+		(outputFunction)(callback->vm, buffer, newline);
+	}
+}
diff --git a/usr/src/common/ficl/vm.c b/usr/src/common/ficl/vm.c
new file mode 100644
index 0000000000..39bd41e8b2
--- /dev/null
+++ b/usr/src/common/ficl/vm.c
@@ -0,0 +1,2785 @@
+/*
+ * v m . c
+ * Forth Inspired Command Language - virtual machine methods
+ * Author: John Sadler (john_sadler@alum.mit.edu)
+ * Created: 19 July 1997
+ * $Id: vm.c,v 1.17 2010/09/13 18:43:04 asau Exp $
+ */
+/*
+ * This file implements the virtual machine of Ficl. Each virtual
+ * machine retains the state of an interpreter. A virtual machine
+ * owns a pair of stacks for parameters and return addresses, as
+ * well as a pile of state variables and the two dedicated registers
+ * of the interpreter.
+ */
+/*
+ * 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.
+ */
+
+#include "ficl.h"
+
+#if FICL_ROBUST >= 2
+#define	FICL_VM_CHECK(vm)	\
+	FICL_VM_ASSERT(vm, (*(vm->ip - 1)) == vm->runningWord)
+#else
+#define	FICL_VM_CHECK(vm)
+#endif
+
+/*
+ * v m B r a n c h R e l a t i v e
+ */
+void
+ficlVmBranchRelative(ficlVm *vm, int offset)
+{
+	vm->ip += offset;
+}
+
+/*
+ * v m C r e a t e
+ * Creates a virtual machine either from scratch (if vm is NULL on entry)
+ * or by resizing and reinitializing an existing VM to the specified stack
+ * sizes.
+ */
+ficlVm *
+ficlVmCreate(ficlVm *vm, unsigned nPStack, unsigned nRStack)
+{
+	if (vm == NULL) {
+		vm = (ficlVm *)ficlMalloc(sizeof (ficlVm));
+		FICL_ASSERT(NULL, vm);
+		memset(vm, 0, sizeof (ficlVm));
+	}
+
+	if (vm->dataStack)
+		ficlStackDestroy(vm->dataStack);
+	vm->dataStack = ficlStackCreate(vm, "data", nPStack);
+
+	if (vm->returnStack)
+		ficlStackDestroy(vm->returnStack);
+	vm->returnStack = ficlStackCreate(vm, "return", nRStack);
+
+#if FICL_WANT_FLOAT
+	if (vm->floatStack)
+		ficlStackDestroy(vm->floatStack);
+	vm->floatStack = ficlStackCreate(vm, "float", nPStack);
+#endif
+
+	ficlVmReset(vm);
+	return (vm);
+}
+
+/*
+ * v m D e l e t e
+ * Free all memory allocated to the specified VM and its subordinate
+ * structures.
+ */
+void
+ficlVmDestroy(ficlVm *vm)
+{
+	if (vm) {
+		ficlFree(vm->dataStack);
+		ficlFree(vm->returnStack);
+#if FICL_WANT_FLOAT
+		ficlFree(vm->floatStack);
+#endif
+		ficlFree(vm);
+	}
+}
+
+/*
+ * v m E x e c u t e
+ * Sets up the specified word to be run by the inner interpreter.
+ * Executes the word's code part immediately, but in the case of
+ * colon definition, the definition itself needs the inner interpreter
+ * to complete. This does not happen until control reaches ficlExec
+ */
+void
+ficlVmExecuteWord(ficlVm *vm, ficlWord *pWord)
+{
+	ficlVmInnerLoop(vm, pWord);
+}
+
+static void
+ficlVmOptimizeJumpToJump(ficlVm *vm, ficlIp ip)
+{
+	ficlIp destination;
+	switch ((ficlInstruction)(*ip)) {
+	case ficlInstructionBranchParenWithCheck:
+		*ip = (ficlWord *)ficlInstructionBranchParen;
+		goto RUNTIME_FIXUP;
+
+	case ficlInstructionBranch0ParenWithCheck:
+		*ip = (ficlWord *)ficlInstructionBranch0Paren;
+RUNTIME_FIXUP:
+		ip++;
+		destination = ip + *(ficlInteger *)ip;
+		switch ((ficlInstruction)*destination) {
+		case ficlInstructionBranchParenWithCheck:
+			/* preoptimize where we're jumping to */
+			ficlVmOptimizeJumpToJump(vm, destination);
+		case ficlInstructionBranchParen:
+			destination++;
+			destination += *(ficlInteger *)destination;
+			*ip = (ficlWord *)(destination - ip);
+		break;
+		}
+	}
+}
+
+/*
+ * v m I n n e r L o o p
+ * the mysterious inner interpreter...
+ * This loop is the address interpreter that makes colon definitions
+ * work. Upon entry, it assumes that the IP points to an entry in
+ * a definition (the body of a colon word). It runs one word at a time
+ * until something does vmThrow. The catcher for this is expected to exist
+ * in the calling code.
+ * vmThrow gets you out of this loop with a longjmp()
+ */
+
+#if FICL_ROBUST <= 1
+	/* turn off stack checking for primitives */
+#define	_CHECK_STACK(stack, top, pop, push)
+#else
+
+#define	_CHECK_STACK(stack, top, pop, push)	\
+	ficlStackCheckNospill(stack, top, pop, push)
+
+FICL_PLATFORM_INLINE void
+ficlStackCheckNospill(ficlStack *stack, ficlCell *top, int popCells,
+    int pushCells)
+{
+	/*
+	 * Why save and restore stack->top?
+	 * So the simple act of stack checking doesn't force a "register" spill,
+	 * which might mask bugs (places where we needed to spill but didn't).
+	 * --lch
+	 */
+	ficlCell *oldTop = stack->top;
+	stack->top = top;
+	ficlStackCheck(stack, popCells, pushCells);
+	stack->top = oldTop;
+}
+
+#endif /* FICL_ROBUST <= 1 */
+
+#define	CHECK_STACK(pop, push)		\
+	_CHECK_STACK(vm->dataStack, dataTop, pop, push)
+#define	CHECK_FLOAT_STACK(pop, push)	\
+	_CHECK_STACK(vm->floatStack, floatTop, pop, push)
+#define	CHECK_RETURN_STACK(pop, push)	\
+	_CHECK_STACK(vm->returnStack, returnTop, pop, push)
+
+#if FICL_WANT_FLOAT
+#define	FLOAT_LOCAL_VARIABLE_SPILL	\
+	vm->floatStack->top = floatTop;
+#define	FLOAT_LOCAL_VARIABLE_REFILL	\
+	floatTop = vm->floatStack->top;
+#else
+#define	FLOAT_LOCAL_VARIABLE_SPILL
+#define	FLOAT_LOCAL_VARIABLE_REFILL
+#endif  /* FICL_WANT_FLOAT */
+
+#if FICL_WANT_LOCALS
+#define	LOCALS_LOCAL_VARIABLE_SPILL	\
+	vm->returnStack->frame = frame;
+#define	LOCALS_LOCAL_VARIABLE_REFILL \
+	frame = vm->returnStack->frame;
+#else
+#define	LOCALS_LOCAL_VARIABLE_SPILL
+#define	LOCALS_LOCAL_VARIABLE_REFILL
+#endif  /* FICL_WANT_FLOAT */
+
+#define	LOCAL_VARIABLE_SPILL	\
+		vm->ip = (ficlIp)ip;	\
+		vm->dataStack->top = dataTop;	\
+		vm->returnStack->top = returnTop;	\
+		FLOAT_LOCAL_VARIABLE_SPILL \
+		LOCALS_LOCAL_VARIABLE_SPILL
+
+#define	LOCAL_VARIABLE_REFILL	\
+		ip = (ficlInstruction *)vm->ip; \
+		dataTop = vm->dataStack->top;	\
+		returnTop = vm->returnStack->top;	\
+		FLOAT_LOCAL_VARIABLE_REFILL	\
+		LOCALS_LOCAL_VARIABLE_REFILL
+
+void
+ficlVmInnerLoop(ficlVm *vm, ficlWord *fw)
+{
+	register ficlInstruction *ip;
+	register ficlCell *dataTop;
+	register ficlCell *returnTop;
+#if FICL_WANT_FLOAT
+	register ficlCell *floatTop;
+	ficlFloat f;
+#endif  /* FICL_WANT_FLOAT */
+#if FICL_WANT_LOCALS
+	register ficlCell *frame;
+#endif  /* FICL_WANT_LOCALS */
+	jmp_buf *oldExceptionHandler;
+	jmp_buf exceptionHandler;
+	int except;
+	int once;
+	int count;
+	ficlInstruction instruction;
+	ficlInteger i;
+	ficlUnsigned u;
+	ficlCell c;
+	ficlCountedString *s;
+	ficlCell *cell;
+	char *cp;
+
+	once = (fw != NULL);
+	if (once)
+		count = 1;
+
+	oldExceptionHandler = vm->exceptionHandler;
+	/* This has to come before the setjmp! */
+	vm->exceptionHandler = &exceptionHandler;
+	except = setjmp(exceptionHandler);
+
+	LOCAL_VARIABLE_REFILL;
+
+	if (except) {
+		LOCAL_VARIABLE_SPILL;
+		vm->exceptionHandler = oldExceptionHandler;
+		ficlVmThrow(vm, except);
+	}
+
+	for (;;) {
+		if (once) {
+			if (!count--)
+				break;
+			instruction = (ficlInstruction)((void *)fw);
+		} else {
+			instruction = *ip++;
+			fw = (ficlWord *)instruction;
+		}
+
+AGAIN:
+		switch (instruction) {
+		case ficlInstructionInvalid:
+			ficlVmThrowError(vm,
+			    "Error: NULL instruction executed!");
+		return;
+
+		case ficlInstruction1:
+		case ficlInstruction2:
+		case ficlInstruction3:
+		case ficlInstruction4:
+		case ficlInstruction5:
+		case ficlInstruction6:
+		case ficlInstruction7:
+		case ficlInstruction8:
+		case ficlInstruction9:
+		case ficlInstruction10:
+		case ficlInstruction11:
+		case ficlInstruction12:
+		case ficlInstruction13:
+		case ficlInstruction14:
+		case ficlInstruction15:
+		case ficlInstruction16:
+			CHECK_STACK(0, 1);
+			(++dataTop)->i = instruction;
+		continue;
+
+		case ficlInstruction0:
+		case ficlInstructionNeg1:
+		case ficlInstructionNeg2:
+		case ficlInstructionNeg3:
+		case ficlInstructionNeg4:
+		case ficlInstructionNeg5:
+		case ficlInstructionNeg6:
+		case ficlInstructionNeg7:
+		case ficlInstructionNeg8:
+		case ficlInstructionNeg9:
+		case ficlInstructionNeg10:
+		case ficlInstructionNeg11:
+		case ficlInstructionNeg12:
+		case ficlInstructionNeg13:
+		case ficlInstructionNeg14:
+		case ficlInstructionNeg15:
+		case ficlInstructionNeg16:
+			CHECK_STACK(0, 1);
+			(++dataTop)->i = ficlInstruction0 - instruction;
+		continue;
+
+		/*
+		 * stringlit: Fetch the count from the dictionary, then push
+		 * the address and count on the stack. Finally, update ip to
+		 * point to the first aligned address after the string text.
+		 */
+		case ficlInstructionStringLiteralParen: {
+			ficlUnsigned8 length;
+			CHECK_STACK(0, 2);
+
+			s = (ficlCountedString *)(ip);
+			length = s->length;
+			cp = s->text;
+			(++dataTop)->p = cp;
+			(++dataTop)->i = length;
+
+			cp += length + 1;
+			cp = ficlAlignPointer(cp);
+			ip = (void *)cp;
+		continue;
+		}
+
+		case ficlInstructionCStringLiteralParen:
+			CHECK_STACK(0, 1);
+
+			s = (ficlCountedString *)(ip);
+			cp = s->text + s->length + 1;
+			cp = ficlAlignPointer(cp);
+			ip = (void *)cp;
+			(++dataTop)->p = s;
+		continue;
+
+#if FICL_WANT_OPTIMIZE == FICL_OPTIMIZE_FOR_SIZE
+#if FICL_WANT_FLOAT
+FLOAT_PUSH_CELL_POINTER_DOUBLE_MINIPROC:
+			*++floatTop = cell[1];
+			/* intentional fall-through */
+FLOAT_PUSH_CELL_POINTER_MINIPROC:
+			*++floatTop = cell[0];
+		continue;
+
+FLOAT_POP_CELL_POINTER_MINIPROC:
+			cell[0] = *floatTop--;
+		continue;
+
+FLOAT_POP_CELL_POINTER_DOUBLE_MINIPROC:
+			cell[0] = *floatTop--;
+			cell[1] = *floatTop--;
+		continue;
+
+#define	FLOAT_PUSH_CELL_POINTER_DOUBLE(cp)	\
+	cell = (cp); goto FLOAT_PUSH_CELL_POINTER_DOUBLE_MINIPROC
+#define	FLOAT_PUSH_CELL_POINTER(cp)		\
+	cell = (cp); goto FLOAT_PUSH_CELL_POINTER_MINIPROC
+#define	FLOAT_POP_CELL_POINTER_DOUBLE(cp)	\
+	cell = (cp); goto FLOAT_POP_CELL_POINTER_DOUBLE_MINIPROC
+#define	FLOAT_POP_CELL_POINTER(cp)		\
+	cell = (cp); goto FLOAT_POP_CELL_POINTER_MINIPROC
+#endif /* FICL_WANT_FLOAT */
+
+		/*
+		 * Think of these as little mini-procedures.
+		 * --lch
+		 */
+PUSH_CELL_POINTER_DOUBLE_MINIPROC:
+			*++dataTop = cell[1];
+			/* intentional fall-through */
+PUSH_CELL_POINTER_MINIPROC:
+			*++dataTop = cell[0];
+		continue;
+
+POP_CELL_POINTER_MINIPROC:
+			cell[0] = *dataTop--;
+		continue;
+POP_CELL_POINTER_DOUBLE_MINIPROC:
+			cell[0] = *dataTop--;
+			cell[1] = *dataTop--;
+		continue;
+
+#define	PUSH_CELL_POINTER_DOUBLE(cp)	\
+	cell = (cp); goto PUSH_CELL_POINTER_DOUBLE_MINIPROC
+#define	PUSH_CELL_POINTER(cp)		\
+	cell = (cp); goto PUSH_CELL_POINTER_MINIPROC
+#define	POP_CELL_POINTER_DOUBLE(cp)	\
+	cell = (cp); goto POP_CELL_POINTER_DOUBLE_MINIPROC
+#define	POP_CELL_POINTER(cp)		\
+	cell = (cp); goto POP_CELL_POINTER_MINIPROC
+
+BRANCH_MINIPROC:
+			ip += *(ficlInteger *)ip;
+		continue;
+
+#define	BRANCH()	goto BRANCH_MINIPROC
+
+EXIT_FUNCTION_MINIPROC:
+			ip = (ficlInstruction *)((returnTop--)->p);
+				continue;
+
+#define	EXIT_FUNCTION	goto EXIT_FUNCTION_MINIPROC
+
+#else /* FICL_WANT_SIZE */
+
+#if FICL_WANT_FLOAT
+#define	FLOAT_PUSH_CELL_POINTER_DOUBLE(cp)	\
+	cell = (cp); *++floatTop = cell[1]; *++floatTop = *cell; continue
+#define	FLOAT_PUSH_CELL_POINTER(cp)		\
+	cell = (cp); *++floatTop = *cell; continue
+#define	FLOAT_POP_CELL_POINTER_DOUBLE(cp)	\
+	cell = (cp); *cell = *floatTop--; cell[1] = *floatTop--; continue
+#define	FLOAT_POP_CELL_POINTER(cp)		\
+	cell = (cp); *cell = *floatTop--; continue
+#endif /* FICL_WANT_FLOAT */
+
+#define	PUSH_CELL_POINTER_DOUBLE(cp)	\
+	cell = (cp); *++dataTop = cell[1]; *++dataTop = *cell; continue
+#define	PUSH_CELL_POINTER(cp)		\
+	cell = (cp); *++dataTop = *cell; continue
+#define	POP_CELL_POINTER_DOUBLE(cp)	\
+	cell = (cp); *cell = *dataTop--; cell[1] = *dataTop--; continue
+#define	POP_CELL_POINTER(cp)		\
+	cell = (cp); *cell = *dataTop--; continue
+
+#define	BRANCH()	ip += *(ficlInteger *)ip; continue
+#define	EXIT_FUNCTION()	ip = (ficlInstruction *)((returnTop--)->p); continue
+
+#endif /* FICL_WANT_SIZE */
+
+
+		/*
+		 * This is the runtime for (literal). It assumes that it is
+		 * part of a colon definition, and that the next ficlCell
+		 * contains a value to be pushed on the parameter stack at
+		 * runtime. This code is compiled by "literal".
+		 */
+
+		case ficlInstructionLiteralParen:
+			CHECK_STACK(0, 1);
+			(++dataTop)->i = *ip++;
+		continue;
+
+		case ficlInstruction2LiteralParen:
+			CHECK_STACK(0, 2);
+			(++dataTop)->i = ip[1];
+			(++dataTop)->i = ip[0];
+			ip += 2;
+		continue;
+
+#if FICL_WANT_LOCALS
+		/*
+		 * Link a frame on the return stack, reserving nCells of space
+		 * for locals - the value of nCells is the next ficlCell in
+		 * the instruction stream.
+		 * 1) Push frame onto returnTop
+		 * 2) frame = returnTop
+		 * 3) returnTop += nCells
+		 */
+		case ficlInstructionLinkParen: {
+			ficlInteger nCells = *ip++;
+			(++returnTop)->p = frame;
+			frame = returnTop + 1;
+			returnTop += nCells;
+		continue;
+		}
+
+		/*
+		 * Unink a stack frame previously created by stackLink
+		 * 1) dataTop = frame
+		 * 2) frame = pop()
+		 */
+		case ficlInstructionUnlinkParen:
+			returnTop = frame - 1;
+			frame = (returnTop--)->p;
+		continue;
+
+		/*
+		 * Immediate - cfa of a local while compiling - when executed,
+		 * compiles code to fetch the value of a local given the
+		 * local's index in the word's pfa
+		 */
+#if FICL_WANT_FLOAT
+		case ficlInstructionGetF2LocalParen:
+			FLOAT_PUSH_CELL_POINTER_DOUBLE(frame + *ip++);
+
+		case ficlInstructionGetFLocalParen:
+			FLOAT_PUSH_CELL_POINTER(frame + *ip++);
+
+		case ficlInstructionToF2LocalParen:
+			FLOAT_POP_CELL_POINTER_DOUBLE(frame + *ip++);
+
+		case ficlInstructionToFLocalParen:
+			FLOAT_POP_CELL_POINTER(frame + *ip++);
+#endif /* FICL_WANT_FLOAT */
+
+		case ficlInstructionGet2LocalParen:
+			PUSH_CELL_POINTER_DOUBLE(frame + *ip++);
+
+		case ficlInstructionGetLocalParen:
+			PUSH_CELL_POINTER(frame + *ip++);
+
+		/*
+		 * Immediate - cfa of a local while compiling - when executed,
+		 * compiles code to store the value of a local given the
+		 * local's index in the word's pfa
+		 */
+
+		case ficlInstructionTo2LocalParen:
+			POP_CELL_POINTER_DOUBLE(frame + *ip++);
+
+		case ficlInstructionToLocalParen:
+			POP_CELL_POINTER(frame + *ip++);
+
+		/*
+		 * Silly little minor optimizations.
+		 * --lch
+		 */
+		case ficlInstructionGetLocal0:
+			PUSH_CELL_POINTER(frame);
+
+		case ficlInstructionGetLocal1:
+			PUSH_CELL_POINTER(frame + 1);
+
+		case ficlInstructionGet2Local0:
+			PUSH_CELL_POINTER_DOUBLE(frame);
+
+		case ficlInstructionToLocal0:
+			POP_CELL_POINTER(frame);
+
+		case ficlInstructionToLocal1:
+			POP_CELL_POINTER(frame + 1);
+
+		case ficlInstructionTo2Local0:
+			POP_CELL_POINTER_DOUBLE(frame);
+
+#endif /* FICL_WANT_LOCALS */
+
+		case ficlInstructionPlus:
+			CHECK_STACK(2, 1);
+			i = (dataTop--)->i;
+			dataTop->i += i;
+		continue;
+
+		case ficlInstructionMinus:
+			CHECK_STACK(2, 1);
+			i = (dataTop--)->i;
+			dataTop->i -= i;
+		continue;
+
+		case ficlInstruction1Plus:
+			CHECK_STACK(1, 1);
+			dataTop->i++;
+		continue;
+
+		case ficlInstruction1Minus:
+			CHECK_STACK(1, 1);
+			dataTop->i--;
+		continue;
+
+		case ficlInstruction2Plus:
+			CHECK_STACK(1, 1);
+			dataTop->i += 2;
+		continue;
+
+		case ficlInstruction2Minus:
+			CHECK_STACK(1, 1);
+			dataTop->i -= 2;
+		continue;
+
+		case ficlInstructionDup: {
+			ficlInteger i = dataTop->i;
+			CHECK_STACK(0, 1);
+			(++dataTop)->i = i;
+			continue;
+		}
+
+		case ficlInstructionQuestionDup:
+			CHECK_STACK(1, 2);
+
+			if (dataTop->i != 0) {
+				dataTop[1] = dataTop[0];
+				dataTop++;
+			}
+
+		continue;
+
+		case ficlInstructionSwap: {
+			ficlCell swap;
+			CHECK_STACK(2, 2);
+			swap = dataTop[0];
+			dataTop[0] = dataTop[-1];
+			dataTop[-1] = swap;
+		}
+		continue;
+
+		case ficlInstructionDrop:
+			CHECK_STACK(1, 0);
+			dataTop--;
+		continue;
+
+		case ficlInstruction2Drop:
+			CHECK_STACK(2, 0);
+			dataTop -= 2;
+		continue;
+
+		case ficlInstruction2Dup:
+			CHECK_STACK(2, 4);
+			dataTop[1] = dataTop[-1];
+			dataTop[2] = *dataTop;
+			dataTop += 2;
+		continue;
+
+		case ficlInstructionOver:
+			CHECK_STACK(2, 3);
+			dataTop[1] = dataTop[-1];
+			dataTop++;
+		continue;
+
+		case ficlInstruction2Over:
+			CHECK_STACK(4, 6);
+			dataTop[1] = dataTop[-3];
+			dataTop[2] = dataTop[-2];
+			dataTop += 2;
+		continue;
+
+		case ficlInstructionPick:
+			CHECK_STACK(1, 0);
+			i = dataTop->i;
+			if (i < 0)
+				continue;
+			CHECK_STACK(i + 2, i + 3);
+			*dataTop = dataTop[-i - 1];
+		continue;
+
+		/*
+		 * Do stack rot.
+		 * rot ( 1 2 3  -- 2 3 1 )
+		 */
+		case ficlInstructionRot:
+			i = 2;
+		goto ROLL;
+
+		/*
+		 * Do stack roll.
+		 * roll ( n -- )
+		 */
+		case ficlInstructionRoll:
+			CHECK_STACK(1, 0);
+			i = (dataTop--)->i;
+
+			if (i < 1)
+				continue;
+
+ROLL:
+			CHECK_STACK(i+1, i+2);
+			c = dataTop[-i];
+			memmove(dataTop - i, dataTop - (i - 1),
+			    i * sizeof (ficlCell));
+			*dataTop = c;
+		continue;
+
+		/*
+		 * Do stack -rot.
+		 * -rot ( 1 2 3  -- 3 1 2 )
+		 */
+		case ficlInstructionMinusRot:
+			i = 2;
+		goto MINUSROLL;
+
+		/*
+		 * Do stack -roll.
+		 * -roll ( n -- )
+		 */
+		case ficlInstructionMinusRoll:
+			CHECK_STACK(1, 0);
+			i = (dataTop--)->i;
+
+			if (i < 1)
+				continue;
+
+MINUSROLL:
+			CHECK_STACK(i+1, i+2);
+			c = *dataTop;
+			memmove(dataTop - (i - 1), dataTop - i,
+			    i * sizeof (ficlCell));
+			dataTop[-i] = c;
+
+		continue;
+
+		/*
+		 * Do stack 2swap
+		 * 2swap ( 1 2 3 4  -- 3 4 1 2 )
+		 */
+		case ficlInstruction2Swap: {
+			ficlCell c2;
+			CHECK_STACK(4, 4);
+
+			c = *dataTop;
+			c2 = dataTop[-1];
+
+			*dataTop = dataTop[-2];
+			dataTop[-1] = dataTop[-3];
+
+			dataTop[-2] = c;
+			dataTop[-3] = c2;
+		continue;
+		}
+
+		case ficlInstructionPlusStore: {
+			ficlCell *cell;
+			CHECK_STACK(2, 0);
+			cell = (ficlCell *)(dataTop--)->p;
+			cell->i += (dataTop--)->i;
+		continue;
+		}
+
+		case ficlInstructionQuadFetch: {
+			ficlUnsigned32 *integer32;
+			CHECK_STACK(1, 1);
+			integer32 = (ficlUnsigned32 *)dataTop->i;
+			dataTop->u = (ficlUnsigned)*integer32;
+		continue;
+		}
+
+		case ficlInstructionQuadStore: {
+			ficlUnsigned32 *integer32;
+			CHECK_STACK(2, 0);
+			integer32 = (ficlUnsigned32 *)(dataTop--)->p;
+			*integer32 = (ficlUnsigned32)((dataTop--)->u);
+		continue;
+		}
+
+		case ficlInstructionWFetch: {
+			ficlUnsigned16 *integer16;
+			CHECK_STACK(1, 1);
+			integer16 = (ficlUnsigned16 *)dataTop->p;
+			dataTop->u = ((ficlUnsigned)*integer16);
+		continue;
+		}
+
+		case ficlInstructionWStore: {
+			ficlUnsigned16 *integer16;
+			CHECK_STACK(2, 0);
+			integer16 = (ficlUnsigned16 *)(dataTop--)->p;
+			*integer16 = (ficlUnsigned16)((dataTop--)->u);
+		continue;
+		}
+
+		case ficlInstructionCFetch: {
+			ficlUnsigned8 *integer8;
+			CHECK_STACK(1, 1);
+			integer8 = (ficlUnsigned8 *)dataTop->p;
+			dataTop->u = ((ficlUnsigned)*integer8);
+		continue;
+		}
+
+		case ficlInstructionCStore: {
+			ficlUnsigned8 *integer8;
+			CHECK_STACK(2, 0);
+			integer8 = (ficlUnsigned8 *)(dataTop--)->p;
+			*integer8 = (ficlUnsigned8)((dataTop--)->u);
+		continue;
+		}
+
+
+		/*
+		 * l o g i c   a n d   c o m p a r i s o n s
+		 */
+
+		case ficlInstruction0Equals:
+			CHECK_STACK(1, 1);
+			dataTop->i = FICL_BOOL(dataTop->i == 0);
+		continue;
+
+		case ficlInstruction0Less:
+			CHECK_STACK(1, 1);
+			dataTop->i = FICL_BOOL(dataTop->i < 0);
+		continue;
+
+		case ficlInstruction0Greater:
+			CHECK_STACK(1, 1);
+			dataTop->i = FICL_BOOL(dataTop->i > 0);
+		continue;
+
+		case ficlInstructionEquals:
+			CHECK_STACK(2, 1);
+			i = (dataTop--)->i;
+			dataTop->i = FICL_BOOL(dataTop->i == i);
+		continue;
+
+		case ficlInstructionLess:
+			CHECK_STACK(2, 1);
+			i = (dataTop--)->i;
+			dataTop->i = FICL_BOOL(dataTop->i < i);
+		continue;
+
+		case ficlInstructionULess:
+			CHECK_STACK(2, 1);
+			u = (dataTop--)->u;
+			dataTop->i = FICL_BOOL(dataTop->u < u);
+		continue;
+
+		case ficlInstructionAnd:
+			CHECK_STACK(2, 1);
+			i = (dataTop--)->i;
+			dataTop->i = dataTop->i & i;
+		continue;
+
+		case ficlInstructionOr:
+			CHECK_STACK(2, 1);
+			i = (dataTop--)->i;
+			dataTop->i = dataTop->i | i;
+		continue;
+
+		case ficlInstructionXor:
+			CHECK_STACK(2, 1);
+			i = (dataTop--)->i;
+			dataTop->i = dataTop->i ^ i;
+		continue;
+
+		case ficlInstructionInvert:
+			CHECK_STACK(1, 1);
+			dataTop->i = ~dataTop->i;
+		continue;
+
+		/*
+		 * r e t u r n   s t a c k
+		 */
+		case ficlInstructionToRStack:
+			CHECK_STACK(1, 0);
+			CHECK_RETURN_STACK(0, 1);
+			*++returnTop = *dataTop--;
+		continue;
+
+		case ficlInstructionFromRStack:
+			CHECK_STACK(0, 1);
+			CHECK_RETURN_STACK(1, 0);
+			*++dataTop = *returnTop--;
+		continue;
+
+		case ficlInstructionFetchRStack:
+			CHECK_STACK(0, 1);
+			CHECK_RETURN_STACK(1, 1);
+			*++dataTop = *returnTop;
+		continue;
+
+		case ficlInstruction2ToR:
+			CHECK_STACK(2, 0);
+			CHECK_RETURN_STACK(0, 2);
+			*++returnTop = dataTop[-1];
+			*++returnTop = dataTop[0];
+			dataTop -= 2;
+		continue;
+
+		case ficlInstruction2RFrom:
+			CHECK_STACK(0, 2);
+			CHECK_RETURN_STACK(2, 0);
+			*++dataTop = returnTop[-1];
+			*++dataTop = returnTop[0];
+			returnTop -= 2;
+		continue;
+
+		case ficlInstruction2RFetch:
+			CHECK_STACK(0, 2);
+			CHECK_RETURN_STACK(2, 2);
+			*++dataTop = returnTop[-1];
+			*++dataTop = returnTop[0];
+		continue;
+
+		/*
+		 * f i l l
+		 * CORE ( c-addr u char -- )
+		 * If u is greater than zero, store char in each of u
+		 * consecutive characters of memory beginning at c-addr.
+		 */
+		case ficlInstructionFill: {
+			char c;
+			char *memory;
+			CHECK_STACK(3, 0);
+			c = (char)(dataTop--)->i;
+			u = (dataTop--)->u;
+			memory = (char *)(dataTop--)->p;
+
+			/*
+			 * memset() is faster than the previous hand-rolled
+			 * solution.  --lch
+			 */
+			memset(memory, c, u);
+		continue;
+		}
+
+		/*
+		 * l s h i f t
+		 * l-shift CORE ( x1 u -- x2 )
+		 * Perform a logical left shift of u bit-places on x1,
+		 * giving x2. Put zeroes into the least significant bits
+		 * vacated by the shift. An ambiguous condition exists if
+		 * u is greater than or equal to the number of bits in a
+		 * ficlCell.
+		 *
+		 * r-shift CORE ( x1 u -- x2 )
+		 * Perform a logical right shift of u bit-places on x1,
+		 * giving x2. Put zeroes into the most significant bits
+		 * vacated by the shift. An ambiguous condition exists
+		 * if u is greater than or equal to the number of bits
+		 * in a ficlCell.
+		 */
+		case ficlInstructionLShift: {
+			ficlUnsigned nBits;
+			ficlUnsigned x1;
+			CHECK_STACK(2, 1);
+
+			nBits = (dataTop--)->u;
+			x1 = dataTop->u;
+			dataTop->u = x1 << nBits;
+		continue;
+		}
+
+		case ficlInstructionRShift: {
+			ficlUnsigned nBits;
+			ficlUnsigned x1;
+			CHECK_STACK(2, 1);
+
+			nBits = (dataTop--)->u;
+			x1 = dataTop->u;
+			dataTop->u = x1 >> nBits;
+			continue;
+		}
+
+		/*
+		 * m a x   &   m i n
+		 */
+		case ficlInstructionMax: {
+			ficlInteger n2;
+			ficlInteger n1;
+			CHECK_STACK(2, 1);
+
+			n2 = (dataTop--)->i;
+			n1 = dataTop->i;
+
+			dataTop->i = ((n1 > n2) ? n1 : n2);
+		continue;
+		}
+
+		case ficlInstructionMin: {
+			ficlInteger n2;
+			ficlInteger n1;
+			CHECK_STACK(2, 1);
+
+			n2 = (dataTop--)->i;
+				n1 = dataTop->i;
+
+			dataTop->i = ((n1 < n2) ? n1 : n2);
+			continue;
+		}
+
+		/*
+		 * m o v e
+		 * CORE ( addr1 addr2 u -- )
+		 * If u is greater than zero, copy the contents of u
+		 * consecutive address units at addr1 to the u consecutive
+		 * address units at addr2. After MOVE completes, the u
+		 * consecutive address units at addr2 contain exactly
+		 * what the u consecutive address units at addr1 contained
+		 * before the move.
+		 * NOTE! This implementation assumes that a char is the same
+		 * size as an address unit.
+		 */
+		case ficlInstructionMove: {
+			ficlUnsigned u;
+			char *addr2;
+			char *addr1;
+			CHECK_STACK(3, 0);
+
+			u = (dataTop--)->u;
+			addr2 = (dataTop--)->p;
+			addr1 = (dataTop--)->p;
+
+			if (u == 0)
+				continue;
+			/*
+			 * Do the copy carefully, so as to be
+			 * correct even if the two ranges overlap
+			 */
+			/* Which ANSI C's memmove() does for you! Yay!  --lch */
+			memmove(addr2, addr1, u);
+		continue;
+		}
+
+		/*
+		 * s t o d
+		 * s-to-d CORE ( n -- d )
+		 * Convert the number n to the double-ficlCell number d with
+		 * the same numerical value.
+		 */
+		case ficlInstructionSToD: {
+			ficlInteger s;
+			CHECK_STACK(1, 2);
+
+			s = dataTop->i;
+
+			/* sign extend to 64 bits.. */
+			(++dataTop)->i = (s < 0) ? -1 : 0;
+		continue;
+		}
+
+		/*
+		 * c o m p a r e
+		 * STRING ( c-addr1 u1 c-addr2 u2 -- n )
+		 * Compare the string specified by c-addr1 u1 to the string
+		 * specified by c-addr2 u2. The strings are compared, beginning
+		 * at the given addresses, character by character, up to the
+		 * length of the shorter string or until a difference is found.
+		 * If the two strings are identical, n is zero. If the two
+		 * strings are identical up to the length of the shorter string,
+		 * n is minus-one (-1) if u1 is less than u2 and one (1)
+		 * otherwise. If the two strings are not identical up to the
+		 * length of the shorter string, n is minus-one (-1) if the
+		 * first non-matching character in the string specified by
+		 * c-addr1 u1 has a lesser numeric value than the corresponding
+		 * character in the string specified by c-addr2 u2 and
+		 * one (1) otherwise.
+		 */
+		case ficlInstructionCompare:
+			i = FICL_FALSE;
+		goto COMPARE;
+
+
+		case ficlInstructionCompareInsensitive:
+			i = FICL_TRUE;
+		goto COMPARE;
+
+COMPARE:
+		{
+			char *cp1, *cp2;
+			ficlUnsigned u1, u2, uMin;
+			int n = 0;
+
+			CHECK_STACK(4, 1);
+			u2  = (dataTop--)->u;
+			cp2 = (char *)(dataTop--)->p;
+			u1  = (dataTop--)->u;
+			cp1 = (char *)(dataTop--)->p;
+
+			uMin = (u1 < u2)? u1 : u2;
+			for (; (uMin > 0) && (n == 0); uMin--) {
+				int c1 = (unsigned char)*cp1++;
+				int c2 = (unsigned char)*cp2++;
+
+				if (i) {
+					c1 = tolower(c1);
+					c2 = tolower(c2);
+				}
+				n = (c1 - c2);
+			}
+
+			if (n == 0)
+				n = (int)(u1 - u2);
+
+			if (n < 0)
+				n = -1;
+			else if (n > 0)
+				n = 1;
+
+			(++dataTop)->i = n;
+		continue;
+		}
+
+		/*
+		 * r a n d o m
+		 * Ficl-specific
+		 */
+		case ficlInstructionRandom:
+			(++dataTop)->i = random();
+		continue;
+
+		/*
+		 * s e e d - r a n d o m
+		 * Ficl-specific
+		 */
+		case ficlInstructionSeedRandom:
+			srandom((dataTop--)->i);
+		continue;
+
+		case ficlInstructionGreaterThan: {
+			ficlInteger x, y;
+			CHECK_STACK(2, 1);
+			y = (dataTop--)->i;
+			x = dataTop->i;
+			dataTop->i = FICL_BOOL(x > y);
+		continue;
+		}
+
+		/*
+		 * This function simply pops the previous instruction
+		 * pointer and returns to the "next" loop. Used for exiting
+		 * from within a definition. Note that exitParen is identical
+		 * to semiParen - they are in two different functions so that
+		 * "see" can correctly identify the end of a colon definition,
+		 * even if it uses "exit".
+		 */
+		case ficlInstructionExitParen:
+		case ficlInstructionSemiParen:
+			EXIT_FUNCTION();
+
+		/*
+		 * The first time we run "(branch)", perform a "peephole
+		 * optimization" to see if we're jumping to another
+		 * unconditional jump.  If so, just jump directly there.
+		 */
+		case ficlInstructionBranchParenWithCheck:
+			LOCAL_VARIABLE_SPILL;
+			ficlVmOptimizeJumpToJump(vm, vm->ip - 1);
+			LOCAL_VARIABLE_REFILL;
+		goto BRANCH_PAREN;
+
+		/*
+		 * Same deal with branch0.
+		 */
+		case ficlInstructionBranch0ParenWithCheck:
+			LOCAL_VARIABLE_SPILL;
+			ficlVmOptimizeJumpToJump(vm, vm->ip - 1);
+			LOCAL_VARIABLE_REFILL;
+			/* intentional fall-through */
+
+		/*
+		 * Runtime code for "(branch0)"; pop a flag from the stack,
+		 * branch if 0. fall through otherwise.
+		 * The heart of "if" and "until".
+		 */
+		case ficlInstructionBranch0Paren:
+			CHECK_STACK(1, 0);
+
+			if ((dataTop--)->i) {
+				/*
+				 * don't branch, but skip over branch
+				 * relative address
+				 */
+				ip += 1;
+				continue;
+			}
+			/* otherwise, take branch (to else/endif/begin) */
+			/* intentional fall-through! */
+
+		/*
+		 * Runtime for "(branch)" -- expects a literal offset in the
+		 * next compilation address, and branches to that location.
+		 */
+		case ficlInstructionBranchParen:
+BRANCH_PAREN:
+			BRANCH();
+
+		case ficlInstructionOfParen: {
+			ficlUnsigned a, b;
+
+			CHECK_STACK(2, 1);
+
+			a = (dataTop--)->u;
+			b = dataTop->u;
+
+			if (a == b) {
+				/* fall through */
+				ip++;
+				/* remove CASE argument */
+				dataTop--;
+			} else {
+				/* take branch to next of or endcase */
+				BRANCH();
+			}
+
+		continue;
+		}
+
+		case ficlInstructionDoParen: {
+			ficlCell index, limit;
+
+			CHECK_STACK(2, 0);
+
+			index = *dataTop--;
+			limit = *dataTop--;
+
+			/* copy "leave" target addr to stack */
+			(++returnTop)->i = *(ip++);
+			*++returnTop = limit;
+			*++returnTop = index;
+
+		continue;
+		}
+
+		case ficlInstructionQDoParen: {
+			ficlCell index, limit, leave;
+
+			CHECK_STACK(2, 0);
+
+			index = *dataTop--;
+			limit = *dataTop--;
+
+			leave.i = *ip;
+
+			if (limit.u == index.u) {
+				ip = leave.p;
+			} else {
+				ip++;
+				*++returnTop = leave;
+				*++returnTop = limit;
+				*++returnTop = index;
+			}
+
+		continue;
+		}
+
+		case ficlInstructionLoopParen:
+		case ficlInstructionPlusLoopParen: {
+			ficlInteger index;
+			ficlInteger limit;
+			int direction = 0;
+
+			index = returnTop->i;
+			limit = returnTop[-1].i;
+
+			if (instruction == ficlInstructionLoopParen)
+				index++;
+			else {
+				ficlInteger increment;
+				CHECK_STACK(1, 0);
+				increment = (dataTop--)->i;
+				index += increment;
+				direction = (increment < 0);
+			}
+
+			if (direction ^ (index >= limit)) {
+				/* nuke the loop indices & "leave" addr */
+				returnTop -= 3;
+				ip++;  /* fall through the loop */
+			} else {	/* update index, branch to loop head */
+				returnTop->i = index;
+				BRANCH();
+			}
+
+		continue;
+		}
+
+
+		/*
+		 * Runtime code to break out of a do..loop construct
+		 * Drop the loop control variables; the branch address
+		 * past "loop" is next on the return stack.
+		 */
+		case ficlInstructionLeave:
+			/* almost unloop */
+			returnTop -= 2;
+			/* exit */
+			EXIT_FUNCTION();
+
+		case ficlInstructionUnloop:
+			returnTop -= 3;
+		continue;
+
+		case ficlInstructionI:
+			*++dataTop = *returnTop;
+		continue;
+
+		case ficlInstructionJ:
+			*++dataTop = returnTop[-3];
+		continue;
+
+		case ficlInstructionK:
+			*++dataTop = returnTop[-6];
+		continue;
+
+		case ficlInstructionDoesParen: {
+			ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+			dictionary->smudge->code =
+			    (ficlPrimitive)ficlInstructionDoDoes;
+			dictionary->smudge->param[0].p = ip;
+			ip = (ficlInstruction *)((returnTop--)->p);
+		continue;
+		}
+
+		case ficlInstructionDoDoes: {
+			ficlCell *cell;
+			ficlIp tempIP;
+
+			CHECK_STACK(0, 1);
+
+			cell = fw->param;
+			tempIP = (ficlIp)((*cell).p);
+			(++dataTop)->p = (cell + 1);
+			(++returnTop)->p = (void *)ip;
+			ip = (ficlInstruction *)tempIP;
+		continue;
+		}
+
+#if FICL_WANT_FLOAT
+		case ficlInstructionF2Fetch:
+			CHECK_FLOAT_STACK(0, 2);
+			CHECK_STACK(1, 0);
+			FLOAT_PUSH_CELL_POINTER_DOUBLE((dataTop--)->p);
+
+		case ficlInstructionFFetch:
+			CHECK_FLOAT_STACK(0, 1);
+			CHECK_STACK(1, 0);
+			FLOAT_PUSH_CELL_POINTER((dataTop--)->p);
+
+		case ficlInstructionF2Store:
+			CHECK_FLOAT_STACK(2, 0);
+			CHECK_STACK(1, 0);
+			FLOAT_POP_CELL_POINTER_DOUBLE((dataTop--)->p);
+
+		case ficlInstructionFStore:
+			CHECK_FLOAT_STACK(1, 0);
+			CHECK_STACK(1, 0);
+			FLOAT_POP_CELL_POINTER((dataTop--)->p);
+#endif /* FICL_WANT_FLOAT */
+
+		/*
+		 * two-fetch CORE ( a-addr -- x1 x2 )
+		 *
+		 * Fetch the ficlCell pair x1 x2 stored at a-addr.
+		 * x2 is stored at a-addr and x1 at the next consecutive
+		 * ficlCell. It is equivalent to the sequence
+		 * DUP ficlCell+ @ SWAP @ .
+		 */
+		case ficlInstruction2Fetch:
+			CHECK_STACK(1, 2);
+			PUSH_CELL_POINTER_DOUBLE((dataTop--)->p);
+
+		/*
+		 * fetch CORE ( a-addr -- x )
+		 *
+		 * x is the value stored at a-addr.
+		 */
+		case ficlInstructionFetch:
+			CHECK_STACK(1, 1);
+			PUSH_CELL_POINTER((dataTop--)->p);
+
+		/*
+		 * two-store    CORE ( x1 x2 a-addr -- )
+		 * Store the ficlCell pair x1 x2 at a-addr, with x2 at a-addr
+		 * and x1 at the next consecutive ficlCell. It is equivalent
+		 * to the sequence SWAP OVER ! ficlCell+ !
+		 */
+		case ficlInstruction2Store:
+			CHECK_STACK(3, 0);
+			POP_CELL_POINTER_DOUBLE((dataTop--)->p);
+
+		/*
+		 * store	CORE ( x a-addr -- )
+		 * Store x at a-addr.
+		 */
+		case ficlInstructionStore:
+			CHECK_STACK(2, 0);
+			POP_CELL_POINTER((dataTop--)->p);
+
+		case ficlInstructionComma: {
+			ficlDictionary *dictionary;
+			CHECK_STACK(1, 0);
+
+			dictionary = ficlVmGetDictionary(vm);
+			ficlDictionaryAppendCell(dictionary, *dataTop--);
+		continue;
+		}
+
+		case ficlInstructionCComma: {
+			ficlDictionary *dictionary;
+			char c;
+			CHECK_STACK(1, 0);
+
+			dictionary = ficlVmGetDictionary(vm);
+			c = (char)(dataTop--)->i;
+			ficlDictionaryAppendCharacter(dictionary, c);
+		continue;
+		}
+
+		case ficlInstructionCells:
+			CHECK_STACK(1, 1);
+			dataTop->i *= sizeof (ficlCell);
+		continue;
+
+		case ficlInstructionCellPlus:
+			CHECK_STACK(1, 1);
+			dataTop->i += sizeof (ficlCell);
+		continue;
+
+		case ficlInstructionStar:
+			CHECK_STACK(2, 1);
+			i = (dataTop--)->i;
+			dataTop->i *= i;
+		continue;
+
+		case ficlInstructionNegate:
+			CHECK_STACK(1, 1);
+			dataTop->i = - dataTop->i;
+		continue;
+
+		case ficlInstructionSlash:
+			CHECK_STACK(2, 1);
+			i = (dataTop--)->i;
+			dataTop->i /= i;
+		continue;
+
+		/*
+		 * slash-mod	CORE ( n1 n2 -- n3 n4 )
+		 * Divide n1 by n2, giving the single-ficlCell remainder n3
+		 * and the single-ficlCell quotient n4. An ambiguous condition
+		 * exists if n2 is zero. If n1 and n2 differ in sign, the
+		 * implementation-defined result returned will be the
+		 * same as that returned by either the phrase
+		 * >R S>D R> FM/MOD or the phrase >R S>D R> SM/REM.
+		 * NOTE: Ficl complies with the second phrase
+		 * (symmetric division)
+		 */
+		case ficlInstructionSlashMod: {
+			ficl2Integer n1;
+			ficlInteger n2;
+			ficl2IntegerQR qr;
+
+			CHECK_STACK(2, 2);
+			n2    = dataTop[0].i;
+			FICL_INTEGER_TO_2INTEGER(dataTop[-1].i, n1);
+
+			qr = ficl2IntegerDivideSymmetric(n1, n2);
+			dataTop[-1].i = qr.remainder;
+			dataTop[0].i = FICL_2UNSIGNED_GET_LOW(qr.quotient);
+		continue;
+		}
+
+		case ficlInstruction2Star:
+			CHECK_STACK(1, 1);
+			dataTop->i <<= 1;
+		continue;
+
+		case ficlInstruction2Slash:
+			CHECK_STACK(1, 1);
+			dataTop->i >>= 1;
+		continue;
+
+		case ficlInstructionStarSlash: {
+			ficlInteger x, y, z;
+			ficl2Integer prod;
+			CHECK_STACK(3, 1);
+
+			z = (dataTop--)->i;
+			y = (dataTop--)->i;
+			x = dataTop->i;
+
+			prod = ficl2IntegerMultiply(x, y);
+			dataTop->i = FICL_2UNSIGNED_GET_LOW(
+			    ficl2IntegerDivideSymmetric(prod, z).quotient);
+		continue;
+		}
+
+		case ficlInstructionStarSlashMod: {
+			ficlInteger x, y, z;
+			ficl2Integer prod;
+			ficl2IntegerQR qr;
+
+			CHECK_STACK(3, 2);
+
+			z = (dataTop--)->i;
+			y = dataTop[0].i;
+			x = dataTop[-1].i;
+
+			prod = ficl2IntegerMultiply(x, y);
+			qr   = ficl2IntegerDivideSymmetric(prod, z);
+
+			dataTop[-1].i = qr.remainder;
+			dataTop[0].i = FICL_2UNSIGNED_GET_LOW(qr.quotient);
+			continue;
+		}
+
+#if FICL_WANT_FLOAT
+		case ficlInstructionF0:
+			CHECK_FLOAT_STACK(0, 1);
+			(++floatTop)->f = 0.0f;
+		continue;
+
+		case ficlInstructionF1:
+			CHECK_FLOAT_STACK(0, 1);
+			(++floatTop)->f = 1.0f;
+		continue;
+
+		case ficlInstructionFNeg1:
+			CHECK_FLOAT_STACK(0, 1);
+			(++floatTop)->f = -1.0f;
+		continue;
+
+		/*
+		 * Floating point literal execution word.
+		 */
+		case ficlInstructionFLiteralParen:
+			CHECK_FLOAT_STACK(0, 1);
+
+			/*
+			 * Yes, I'm using ->i here,
+			 * but it's really a float.  --lch
+			 */
+			(++floatTop)->i = *ip++;
+				continue;
+
+		/*
+		 * Do float addition r1 + r2.
+		 * f+ ( r1 r2 -- r )
+		 */
+		case ficlInstructionFPlus:
+			CHECK_FLOAT_STACK(2, 1);
+
+			f = (floatTop--)->f;
+			floatTop->f += f;
+		continue;
+
+		/*
+		 * Do float subtraction r1 - r2.
+		 * f- ( r1 r2 -- r )
+		 */
+		case ficlInstructionFMinus:
+			CHECK_FLOAT_STACK(2, 1);
+
+			f = (floatTop--)->f;
+			floatTop->f -= f;
+		continue;
+
+		/*
+		 * Do float multiplication r1 * r2.
+		 * f* ( r1 r2 -- r )
+		 */
+		case ficlInstructionFStar:
+			CHECK_FLOAT_STACK(2, 1);
+
+			f = (floatTop--)->f;
+			floatTop->f *= f;
+		continue;
+
+		/*
+		 * Do float negation.
+		 * fnegate ( r -- r )
+		 */
+		case ficlInstructionFNegate:
+			CHECK_FLOAT_STACK(1, 1);
+
+			floatTop->f = -(floatTop->f);
+		continue;
+
+		/*
+		 * Do float division r1 / r2.
+		 * f/ ( r1 r2 -- r )
+		 */
+		case ficlInstructionFSlash:
+			CHECK_FLOAT_STACK(2, 1);
+
+			f = (floatTop--)->f;
+			floatTop->f /= f;
+		continue;
+
+		/*
+		 * Do float + integer r + n.
+		 * f+i ( r n -- r )
+		 */
+		case ficlInstructionFPlusI:
+			CHECK_FLOAT_STACK(1, 1);
+			CHECK_STACK(1, 0);
+
+			f = (ficlFloat)(dataTop--)->f;
+			floatTop->f += f;
+		continue;
+
+		/*
+		 * Do float - integer r - n.
+		 * f-i ( r n -- r )
+		 */
+		case ficlInstructionFMinusI:
+			CHECK_FLOAT_STACK(1, 1);
+			CHECK_STACK(1, 0);
+
+			f = (ficlFloat)(dataTop--)->f;
+			floatTop->f -= f;
+		continue;
+
+		/*
+		 * Do float * integer r * n.
+		 * f*i ( r n -- r )
+		 */
+		case ficlInstructionFStarI:
+			CHECK_FLOAT_STACK(1, 1);
+			CHECK_STACK(1, 0);
+
+			f = (ficlFloat)(dataTop--)->f;
+			floatTop->f *= f;
+		continue;
+
+		/*
+		 * Do float / integer r / n.
+		 * f/i ( r n -- r )
+		 */
+		case ficlInstructionFSlashI:
+			CHECK_FLOAT_STACK(1, 1);
+			CHECK_STACK(1, 0);
+
+			f = (ficlFloat)(dataTop--)->f;
+			floatTop->f /= f;
+			continue;
+
+		/*
+		 * Do integer - float n - r.
+		 * i-f ( n r -- r )
+		 */
+		case ficlInstructionIMinusF:
+			CHECK_FLOAT_STACK(1, 1);
+			CHECK_STACK(1, 0);
+
+			f = (ficlFloat)(dataTop--)->f;
+			floatTop->f = f - floatTop->f;
+		continue;
+
+		/*
+		 * Do integer / float n / r.
+		 * i/f ( n r -- r )
+		 */
+		case ficlInstructionISlashF:
+			CHECK_FLOAT_STACK(1, 1);
+			CHECK_STACK(1, 0);
+
+			f = (ficlFloat)(dataTop--)->f;
+			floatTop->f = f / floatTop->f;
+		continue;
+
+		/*
+		 * Do integer to float conversion.
+		 * int>float ( n -- r )
+		 */
+		case ficlInstructionIntToFloat:
+			CHECK_STACK(1, 0);
+			CHECK_FLOAT_STACK(0, 1);
+
+			(++floatTop)->f = ((dataTop--)->f);
+		continue;
+
+		/*
+		 * Do float to integer conversion.
+		 * float>int ( r -- n )
+		 */
+		case ficlInstructionFloatToInt:
+			CHECK_STACK(0, 1);
+			CHECK_FLOAT_STACK(1, 0);
+
+			(++dataTop)->i = ((floatTop--)->i);
+		continue;
+
+		/*
+		 * Add a floating point number to contents of a variable.
+		 * f+! ( r n -- )
+		 */
+		case ficlInstructionFPlusStore: {
+			ficlCell *cell;
+
+			CHECK_STACK(1, 0);
+			CHECK_FLOAT_STACK(1, 0);
+
+			cell = (ficlCell *)(dataTop--)->p;
+			cell->f += (floatTop--)->f;
+		continue;
+		}
+
+		/*
+		 * Do float stack drop.
+		 * fdrop ( r -- )
+		 */
+		case ficlInstructionFDrop:
+			CHECK_FLOAT_STACK(1, 0);
+			floatTop--;
+		continue;
+
+		/*
+		 * Do float stack ?dup.
+		 * f?dup ( r -- r )
+		 */
+		case ficlInstructionFQuestionDup:
+			CHECK_FLOAT_STACK(1, 2);
+
+			if (floatTop->f != 0)
+				goto FDUP;
+
+		continue;
+
+		/*
+		 * Do float stack dup.
+		 * fdup ( r -- r r )
+		 */
+		case ficlInstructionFDup:
+			CHECK_FLOAT_STACK(1, 2);
+
+FDUP:
+			floatTop[1] = floatTop[0];
+			floatTop++;
+			continue;
+
+		/*
+		 * Do float stack swap.
+		 * fswap ( r1 r2 -- r2 r1 )
+		 */
+		case ficlInstructionFSwap:
+			CHECK_FLOAT_STACK(2, 2);
+
+			c = floatTop[0];
+			floatTop[0] = floatTop[-1];
+			floatTop[-1] = c;
+		continue;
+
+		/*
+		 * Do float stack 2drop.
+		 * f2drop ( r r -- )
+		 */
+		case ficlInstructionF2Drop:
+			CHECK_FLOAT_STACK(2, 0);
+
+			floatTop -= 2;
+		continue;
+
+		/*
+		 * Do float stack 2dup.
+		 * f2dup ( r1 r2 -- r1 r2 r1 r2 )
+		 */
+		case ficlInstructionF2Dup:
+			CHECK_FLOAT_STACK(2, 4);
+
+			floatTop[1] = floatTop[-1];
+			floatTop[2] = *floatTop;
+			floatTop += 2;
+		continue;
+
+		/*
+		 * Do float stack over.
+		 * fover ( r1 r2 -- r1 r2 r1 )
+		 */
+		case ficlInstructionFOver:
+			CHECK_FLOAT_STACK(2, 3);
+
+			floatTop[1] = floatTop[-1];
+			floatTop++;
+		continue;
+
+		/*
+		 * Do float stack 2over.
+		 * f2over ( r1 r2 r3 -- r1 r2 r3 r1 r2 )
+		 */
+		case ficlInstructionF2Over:
+			CHECK_FLOAT_STACK(4, 6);
+
+			floatTop[1] = floatTop[-2];
+			floatTop[2] = floatTop[-1];
+			floatTop += 2;
+		continue;
+
+		/*
+		 * Do float stack pick.
+		 * fpick ( n -- r )
+		 */
+		case ficlInstructionFPick:
+			CHECK_STACK(1, 0);
+			c = *dataTop--;
+			CHECK_FLOAT_STACK(c.i+2, c.i+3);
+
+			floatTop[1] = floatTop[- c.i - 1];
+		continue;
+
+		/*
+		 * Do float stack rot.
+		 * frot ( r1 r2 r3  -- r2 r3 r1 )
+		 */
+		case ficlInstructionFRot:
+			i = 2;
+		goto FROLL;
+
+		/*
+		 * Do float stack roll.
+		 * froll ( n -- )
+		 */
+		case ficlInstructionFRoll:
+			CHECK_STACK(1, 0);
+			i = (dataTop--)->i;
+
+			if (i < 1)
+				continue;
+
+FROLL:
+			CHECK_FLOAT_STACK(i+1, i+2);
+			c = floatTop[-i];
+			memmove(floatTop - i, floatTop - (i - 1),
+			    i * sizeof (ficlCell));
+			*floatTop = c;
+
+		continue;
+
+		/*
+		 * Do float stack -rot.
+		 * f-rot ( r1 r2 r3  -- r3 r1 r2 )
+		 */
+		case ficlInstructionFMinusRot:
+			i = 2;
+			goto FMINUSROLL;
+
+
+		/*
+		 * Do float stack -roll.
+		 * f-roll ( n -- )
+		 */
+		case ficlInstructionFMinusRoll:
+			CHECK_STACK(1, 0);
+			i = (dataTop--)->i;
+
+			if (i < 1)
+				continue;
+
+FMINUSROLL:
+			CHECK_FLOAT_STACK(i+1, i+2);
+			c = *floatTop;
+			memmove(floatTop - (i - 1), floatTop - i,
+			    i * sizeof (ficlCell));
+			floatTop[-i] = c;
+
+		continue;
+
+		/*
+		 * Do float stack 2swap
+		 * f2swap ( r1 r2 r3 r4  -- r3 r4 r1 r2 )
+		 */
+		case ficlInstructionF2Swap: {
+			ficlCell c2;
+			CHECK_FLOAT_STACK(4, 4);
+
+			c = *floatTop;
+			c2 = floatTop[-1];
+
+			*floatTop = floatTop[-2];
+			floatTop[-1] = floatTop[-3];
+
+			floatTop[-2] = c;
+			floatTop[-3] = c2;
+		continue;
+		}
+
+		/*
+		 * Do float 0= comparison r = 0.0.
+		 * f0= ( r -- T/F )
+		 */
+		case ficlInstructionF0Equals:
+			CHECK_FLOAT_STACK(1, 0);
+			CHECK_STACK(0, 1);
+
+			(++dataTop)->i = FICL_BOOL((floatTop--)->f != 0.0f);
+		continue;
+
+		/*
+		 * Do float 0< comparison r < 0.0.
+		 * f0< ( r -- T/F )
+		 */
+		case ficlInstructionF0Less:
+			CHECK_FLOAT_STACK(1, 0);
+			CHECK_STACK(0, 1);
+
+			(++dataTop)->i = FICL_BOOL((floatTop--)->f < 0.0f);
+		continue;
+
+		/*
+		 * Do float 0> comparison r > 0.0.
+		 * f0> ( r -- T/F )
+		 */
+		case ficlInstructionF0Greater:
+			CHECK_FLOAT_STACK(1, 0);
+			CHECK_STACK(0, 1);
+
+			(++dataTop)->i = FICL_BOOL((floatTop--)->f > 0.0f);
+		continue;
+
+		/*
+		 * Do float = comparison r1 = r2.
+		 * f= ( r1 r2 -- T/F )
+		 */
+		case ficlInstructionFEquals:
+			CHECK_FLOAT_STACK(2, 0);
+			CHECK_STACK(0, 1);
+
+			f = (floatTop--)->f;
+			(++dataTop)->i = FICL_BOOL((floatTop--)->f == f);
+		continue;
+
+		/*
+		 * Do float < comparison r1 < r2.
+		 * f< ( r1 r2 -- T/F )
+		 */
+		case ficlInstructionFLess:
+			CHECK_FLOAT_STACK(2, 0);
+			CHECK_STACK(0, 1);
+
+			f = (floatTop--)->f;
+			(++dataTop)->i = FICL_BOOL((floatTop--)->f < f);
+		continue;
+
+		/*
+		 * Do float > comparison r1 > r2.
+		 * f> ( r1 r2 -- T/F )
+		 */
+		case ficlInstructionFGreater:
+			CHECK_FLOAT_STACK(2, 0);
+			CHECK_STACK(0, 1);
+
+			f = (floatTop--)->f;
+			(++dataTop)->i = FICL_BOOL((floatTop--)->f > f);
+		continue;
+
+
+		/*
+		 * Move float to param stack (assumes they both fit in a
+		 * single ficlCell) f>s
+		 */
+		case ficlInstructionFFrom:
+			CHECK_FLOAT_STACK(1, 0);
+			CHECK_STACK(0, 1);
+
+			*++dataTop = *floatTop--;
+		continue;
+
+		case ficlInstructionToF:
+			CHECK_FLOAT_STACK(0, 1);
+			CHECK_STACK(1, 0);
+
+			*++floatTop = *dataTop--;
+		continue;
+
+#endif /* FICL_WANT_FLOAT */
+
+		/*
+		 * c o l o n P a r e n
+		 * This is the code that executes a colon definition. It
+		 * assumes that the virtual machine is running a "next" loop
+		 * (See the vm.c for its implementation of member function
+		 * vmExecute()). The colon code simply copies the address of
+		 * the first word in the list of words to interpret into IP
+		 * after saving its old value. When we return to the "next"
+		 * loop, the virtual machine will call the code for each
+		 * word in turn.
+		 */
+		case ficlInstructionColonParen:
+			(++returnTop)->p = (void *)ip;
+			ip = (ficlInstruction *)(fw->param);
+		continue;
+
+		case ficlInstructionCreateParen:
+			CHECK_STACK(0, 1);
+			(++dataTop)->p = (fw->param + 1);
+		continue;
+
+		case ficlInstructionVariableParen:
+			CHECK_STACK(0, 1);
+			(++dataTop)->p = fw->param;
+		continue;
+
+		/*
+		 * c o n s t a n t P a r e n
+		 * This is the run-time code for "constant". It simply returns
+		 * the contents of its word's first data ficlCell.
+		 */
+
+#if FICL_WANT_FLOAT
+		case ficlInstructionF2ConstantParen:
+			CHECK_FLOAT_STACK(0, 2);
+			FLOAT_PUSH_CELL_POINTER_DOUBLE(fw->param);
+
+		case ficlInstructionFConstantParen:
+			CHECK_FLOAT_STACK(0, 1);
+			FLOAT_PUSH_CELL_POINTER(fw->param);
+#endif /* FICL_WANT_FLOAT */
+
+		case ficlInstruction2ConstantParen:
+			CHECK_STACK(0, 2);
+			PUSH_CELL_POINTER_DOUBLE(fw->param);
+
+		case ficlInstructionConstantParen:
+			CHECK_STACK(0, 1);
+			PUSH_CELL_POINTER(fw->param);
+
+#if FICL_WANT_USER
+		case ficlInstructionUserParen: {
+			ficlInteger i = fw->param[0].i;
+			(++dataTop)->p = &vm->user[i];
+		continue;
+		}
+#endif
+
+		default:
+		/*
+		 * Clever hack, or evil coding?  You be the judge.
+		 *
+		 * If the word we've been asked to execute is in fact
+		 * an *instruction*, we grab the instruction, stow it
+		 * in "i" (our local cache of *ip), and *jump* to the
+		 * top of the switch statement.  --lch
+		 */
+			if (((ficlInstruction)fw->code >
+			    ficlInstructionInvalid) &&
+			    ((ficlInstruction)fw->code < ficlInstructionLast)) {
+				instruction = (ficlInstruction)fw->code;
+				goto AGAIN;
+			}
+
+			LOCAL_VARIABLE_SPILL;
+			(vm)->runningWord = fw;
+			fw->code(vm);
+			LOCAL_VARIABLE_REFILL;
+		continue;
+		}
+	}
+
+	LOCAL_VARIABLE_SPILL;
+	vm->exceptionHandler = oldExceptionHandler;
+}
+
+/*
+ * v m G e t D i c t
+ * Returns the address dictionary for this VM's system
+ */
+ficlDictionary *
+ficlVmGetDictionary(ficlVm *vm)
+{
+	FICL_VM_ASSERT(vm, vm);
+	return (vm->callback.system->dictionary);
+}
+
+/*
+ * v m G e t S t r i n g
+ * Parses a string out of the VM input buffer and copies up to the first
+ * FICL_COUNTED_STRING_MAX characters to the supplied destination buffer, a
+ * ficlCountedString. The destination string is NULL terminated.
+ *
+ * Returns the address of the first unused character in the dest buffer.
+ */
+char *
+ficlVmGetString(ficlVm *vm, ficlCountedString *counted, char delimiter)
+{
+	ficlString s = ficlVmParseStringEx(vm, delimiter, 0);
+
+	if (FICL_STRING_GET_LENGTH(s) > FICL_COUNTED_STRING_MAX) {
+		FICL_STRING_SET_LENGTH(s, FICL_COUNTED_STRING_MAX);
+	}
+
+	strncpy(counted->text, FICL_STRING_GET_POINTER(s),
+	    FICL_STRING_GET_LENGTH(s));
+	counted->text[FICL_STRING_GET_LENGTH(s)] = '\0';
+	counted->length = (ficlUnsigned8)FICL_STRING_GET_LENGTH(s);
+
+	return (counted->text + FICL_STRING_GET_LENGTH(s) + 1);
+}
+
+/*
+ * v m G e t W o r d
+ * vmGetWord calls vmGetWord0 repeatedly until it gets a string with
+ * non-zero length.
+ */
+ficlString
+ficlVmGetWord(ficlVm *vm)
+{
+	ficlString s = ficlVmGetWord0(vm);
+
+	if (FICL_STRING_GET_LENGTH(s) == 0) {
+		ficlVmThrow(vm, FICL_VM_STATUS_RESTART);
+	}
+
+	return (s);
+}
+
+/*
+ * v m G e t W o r d 0
+ * Skip leading whitespace and parse a space delimited word from the tib.
+ * Returns the start address and length of the word. Updates the tib
+ * to reflect characters consumed, including the trailing delimiter.
+ * If there's nothing of interest in the tib, returns zero. This function
+ * does not use vmParseString because it uses isspace() rather than a
+ * single  delimiter character.
+ */
+ficlString
+ficlVmGetWord0(ficlVm *vm)
+{
+	char *trace = ficlVmGetInBuf(vm);
+	char *stop = ficlVmGetInBufEnd(vm);
+	ficlString s;
+	ficlUnsigned length = 0;
+	char c = 0;
+
+	trace = ficlStringSkipSpace(trace, stop);
+	FICL_STRING_SET_POINTER(s, trace);
+
+	/* Please leave this loop this way; it makes Purify happier.  --lch */
+	for (;;) {
+		if (trace == stop)
+			break;
+		c = *trace;
+		if (isspace((unsigned char)c))
+			break;
+		length++;
+		trace++;
+	}
+
+	FICL_STRING_SET_LENGTH(s, length);
+
+	/* skip one trailing delimiter */
+	if ((trace != stop) && isspace((unsigned char)c))
+		trace++;
+
+	ficlVmUpdateTib(vm, trace);
+
+	return (s);
+}
+
+/*
+ * v m G e t W o r d T o P a d
+ * Does vmGetWord and copies the result to the pad as a NULL terminated
+ * string. Returns the length of the string. If the string is too long
+ * to fit in the pad, it is truncated.
+ */
+int
+ficlVmGetWordToPad(ficlVm *vm)
+{
+	ficlString s;
+	char *pad = (char *)vm->pad;
+	s = ficlVmGetWord(vm);
+
+	if (FICL_STRING_GET_LENGTH(s) > FICL_PAD_SIZE)
+		FICL_STRING_SET_LENGTH(s, FICL_PAD_SIZE);
+
+	strncpy(pad, FICL_STRING_GET_POINTER(s), FICL_STRING_GET_LENGTH(s));
+	pad[FICL_STRING_GET_LENGTH(s)] = '\0';
+	return ((int)(FICL_STRING_GET_LENGTH(s)));
+}
+
+/*
+ * v m P a r s e S t r i n g
+ * Parses a string out of the input buffer using the delimiter
+ * specified. Skips leading delimiters, marks the start of the string,
+ * and counts characters to the next delimiter it encounters. It then
+ * updates the vm input buffer to consume all these chars, including the
+ * trailing delimiter.
+ * Returns the address and length of the parsed string, not including the
+ * trailing delimiter.
+ */
+ficlString
+ficlVmParseString(ficlVm *vm, char delimiter)
+{
+	return (ficlVmParseStringEx(vm, delimiter, 1));
+}
+
+ficlString
+ficlVmParseStringEx(ficlVm *vm, char delimiter, char skipLeadingDelimiters)
+{
+	ficlString s;
+	char *trace = ficlVmGetInBuf(vm);
+	char *stop = ficlVmGetInBufEnd(vm);
+	char c;
+
+	if (skipLeadingDelimiters) {
+		while ((trace != stop) && (*trace == delimiter))
+			trace++;
+	}
+
+	FICL_STRING_SET_POINTER(s, trace);    /* mark start of text */
+
+	/* find next delimiter or end of line */
+	for (c = *trace;
+	    (trace != stop) && (c != delimiter) && (c != '\r') && (c != '\n');
+	    c = *++trace) {
+		;
+	}
+
+	/* set length of result */
+	FICL_STRING_SET_LENGTH(s, trace - FICL_STRING_GET_POINTER(s));
+
+	/* gobble trailing delimiter */
+	if ((trace != stop) && (*trace == delimiter))
+		trace++;
+
+	ficlVmUpdateTib(vm, trace);
+	return (s);
+}
+
+
+/*
+ * v m P o p
+ */
+ficlCell
+ficlVmPop(ficlVm *vm)
+{
+	return (ficlStackPop(vm->dataStack));
+}
+
+/*
+ * v m P u s h
+ */
+void
+ficlVmPush(ficlVm *vm, ficlCell c)
+{
+	ficlStackPush(vm->dataStack, c);
+}
+
+/*
+ * v m P o p I P
+ */
+void
+ficlVmPopIP(ficlVm *vm)
+{
+	vm->ip = (ficlIp)(ficlStackPopPointer(vm->returnStack));
+}
+
+/*
+ * v m P u s h I P
+ */
+void
+ficlVmPushIP(ficlVm *vm, ficlIp newIP)
+{
+	ficlStackPushPointer(vm->returnStack, (void *)vm->ip);
+	vm->ip = newIP;
+}
+
+/*
+ * v m P u s h T i b
+ * Binds the specified input string to the VM and clears >IN (the index)
+ */
+void
+ficlVmPushTib(ficlVm *vm, char *text, ficlInteger nChars, ficlTIB *pSaveTib)
+{
+	if (pSaveTib) {
+		*pSaveTib = vm->tib;
+	}
+	vm->tib.text = text;
+	vm->tib.end = text + nChars;
+	vm->tib.index = 0;
+}
+
+void
+ficlVmPopTib(ficlVm *vm, ficlTIB *pTib)
+{
+	if (pTib) {
+		vm->tib = *pTib;
+	}
+}
+
+/*
+ * v m Q u i t
+ */
+void
+ficlVmQuit(ficlVm *vm)
+{
+	ficlStackReset(vm->returnStack);
+	vm->restart = 0;
+	vm->ip = NULL;
+	vm->runningWord = NULL;
+	vm->state = FICL_VM_STATE_INTERPRET;
+	vm->tib.text = NULL;
+	vm->tib.end = NULL;
+	vm->tib.index = 0;
+	vm->pad[0] = '\0';
+	vm->sourceId.i = 0;
+}
+
+/*
+ * v m R e s e t
+ */
+void
+ficlVmReset(ficlVm *vm)
+{
+	ficlVmQuit(vm);
+	ficlStackReset(vm->dataStack);
+#if FICL_WANT_FLOAT
+	ficlStackReset(vm->floatStack);
+#endif
+	vm->base = 10;
+}
+
+/*
+ * v m S e t T e x t O u t
+ * Binds the specified output callback to the vm. If you pass NULL,
+ * binds the default output function (ficlTextOut)
+ */
+void
+ficlVmSetTextOut(ficlVm *vm, ficlOutputFunction textOut)
+{
+	vm->callback.textOut = textOut;
+}
+
+void
+ficlVmTextOut(ficlVm *vm, char *text)
+{
+	ficlCallbackTextOut((ficlCallback *)vm, text);
+}
+
+
+void
+ficlVmErrorOut(ficlVm *vm, char *text)
+{
+	ficlCallbackErrorOut((ficlCallback *)vm, text);
+}
+
+
+/*
+ * v m T h r o w
+ */
+void
+ficlVmThrow(ficlVm *vm, int except)
+{
+	if (vm->exceptionHandler)
+		longjmp(*(vm->exceptionHandler), except);
+}
+
+void
+ficlVmThrowError(ficlVm *vm, char *fmt, ...)
+{
+	va_list list;
+
+	va_start(list, fmt);
+	vsprintf(vm->pad, fmt, list);
+	va_end(list);
+	strcat(vm->pad, "\n");
+
+	ficlVmErrorOut(vm, vm->pad);
+	longjmp(*(vm->exceptionHandler), FICL_VM_STATUS_ERROR_EXIT);
+}
+
+void
+ficlVmThrowErrorVararg(ficlVm *vm, char *fmt, va_list list)
+{
+	vsprintf(vm->pad, fmt, list);
+	/*
+	 * well, we can try anyway, we're certainly not
+	 * returning to our caller!
+	 */
+	va_end(list);
+	strcat(vm->pad, "\n");
+
+	ficlVmErrorOut(vm, vm->pad);
+	longjmp(*(vm->exceptionHandler), FICL_VM_STATUS_ERROR_EXIT);
+}
+
+/*
+ * f i c l E v a l u a t e
+ * Wrapper for ficlExec() which sets SOURCE-ID to -1.
+ */
+int
+ficlVmEvaluate(ficlVm *vm, char *s)
+{
+	int returnValue;
+	ficlCell id = vm->sourceId;
+	ficlString string;
+	vm->sourceId.i = -1;
+	FICL_STRING_SET_FROM_CSTRING(string, s);
+	returnValue = ficlVmExecuteString(vm, string);
+	vm->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
+ * interpreter's output function.
+ *
+ * Contains the "inner interpreter" code in a tight loop
+ *
+ * Returns one of the VM_XXXX codes defined in ficl.h:
+ * VM_OUTOFTEXT is the normal exit condition
+ * VM_ERREXIT means that the interpreter encountered a syntax error
+ *      and the vm has been reset to recover (some or all
+ *      of the text block got ignored
+ * VM_USEREXIT means that the user executed the "bye" command
+ *      to shut down the interpreter. This would be a good
+ *      time to delete the vm, etc -- or you can ignore this
+ *      signal.
+ */
+int
+ficlVmExecuteString(ficlVm *vm, ficlString s)
+{
+	ficlSystem *system = vm->callback.system;
+	ficlDictionary *dictionary = system->dictionary;
+
+	int except;
+	jmp_buf vmState;
+	jmp_buf *oldState;
+	ficlTIB saveficlTIB;
+
+	FICL_VM_ASSERT(vm, vm);
+	FICL_VM_ASSERT(vm, system->interpreterLoop[0]);
+
+	ficlVmPushTib(vm, FICL_STRING_GET_POINTER(s),
+	    FICL_STRING_GET_LENGTH(s), &saveficlTIB);
+
+	/*
+	 * Save and restore VM's jmp_buf to enable nested calls to ficlExec
+	 */
+	oldState = vm->exceptionHandler;
+
+	/* This has to come before the setjmp! */
+	vm->exceptionHandler = &vmState;
+	except = setjmp(vmState);
+
+	switch (except) {
+	case 0:
+		if (vm->restart) {
+			vm->runningWord->code(vm);
+			vm->restart = 0;
+		} else {	/* set VM up to interpret text */
+			ficlVmPushIP(vm, &(system->interpreterLoop[0]));
+		}
+
+		ficlVmInnerLoop(vm, 0);
+	break;
+
+	case FICL_VM_STATUS_RESTART:
+		vm->restart = 1;
+		except = FICL_VM_STATUS_OUT_OF_TEXT;
+	break;
+
+	case FICL_VM_STATUS_OUT_OF_TEXT:
+		ficlVmPopIP(vm);
+#if 0	/* we dont output prompt in loader */
+		if ((vm->state != FICL_VM_STATE_COMPILE) &&
+		    (vm->sourceId.i == 0))
+			ficlVmTextOut(vm, FICL_PROMPT);
+#endif
+	break;
+
+	case FICL_VM_STATUS_USER_EXIT:
+	case FICL_VM_STATUS_INNER_EXIT:
+	case FICL_VM_STATUS_BREAK:
+	break;
+
+	case FICL_VM_STATUS_QUIT:
+		if (vm->state == FICL_VM_STATE_COMPILE) {
+			ficlDictionaryAbortDefinition(dictionary);
+#if FICL_WANT_LOCALS
+			ficlDictionaryEmpty(system->locals,
+			    system->locals->forthWordlist->size);
+#endif
+		}
+		ficlVmQuit(vm);
+	break;
+
+	case FICL_VM_STATUS_ERROR_EXIT:
+	case FICL_VM_STATUS_ABORT:
+	case FICL_VM_STATUS_ABORTQ:
+	default:		/* user defined exit code?? */
+		if (vm->state == FICL_VM_STATE_COMPILE) {
+			ficlDictionaryAbortDefinition(dictionary);
+#if FICL_WANT_LOCALS
+			ficlDictionaryEmpty(system->locals,
+			    system->locals->forthWordlist->size);
+#endif
+		}
+		ficlDictionaryResetSearchOrder(dictionary);
+		ficlVmReset(vm);
+	break;
+	}
+
+	vm->exceptionHandler = oldState;
+	ficlVmPopTib(vm, &saveficlTIB);
+	return (except);
+}
+
+/*
+ * f i c l E x e c X T
+ * Given a pointer to a ficlWord, push an inner interpreter and
+ * execute the word to completion. This is in contrast with vmExecute,
+ * which does not guarantee that the word will have completed when
+ * the function returns (ie in the case of colon definitions, which
+ * need an inner interpreter to finish)
+ *
+ * Returns one of the VM_XXXX exception codes listed in ficl.h. Normal
+ * exit condition is VM_INNEREXIT, Ficl's private signal to exit the
+ * inner loop under normal circumstances. If another code is thrown to
+ * exit the loop, this function will re-throw it if it's nested under
+ * itself or ficlExec.
+ *
+ * NOTE: this function is intended so that C code can execute ficlWords
+ * given their address in the dictionary (xt).
+ */
+int
+ficlVmExecuteXT(ficlVm *vm, ficlWord *pWord)
+{
+	int except;
+	jmp_buf vmState;
+	jmp_buf *oldState;
+	ficlWord *oldRunningWord;
+
+	FICL_VM_ASSERT(vm, vm);
+	FICL_VM_ASSERT(vm, vm->callback.system->exitInnerWord);
+
+	/*
+	 * Save the runningword so that RESTART behaves correctly
+	 * over nested calls.
+	 */
+	oldRunningWord = vm->runningWord;
+	/*
+	 * Save and restore VM's jmp_buf to enable nested calls
+	 */
+	oldState = vm->exceptionHandler;
+	/* This has to come before the setjmp! */
+	vm->exceptionHandler = &vmState;
+	except = setjmp(vmState);
+
+	if (except)
+		ficlVmPopIP(vm);
+	else
+		ficlVmPushIP(vm, &(vm->callback.system->exitInnerWord));
+
+	switch (except) {
+	case 0:
+		ficlVmExecuteWord(vm, pWord);
+		ficlVmInnerLoop(vm, 0);
+	break;
+
+	case FICL_VM_STATUS_INNER_EXIT:
+	case FICL_VM_STATUS_BREAK:
+	break;
+
+	case FICL_VM_STATUS_RESTART:
+	case FICL_VM_STATUS_OUT_OF_TEXT:
+	case FICL_VM_STATUS_USER_EXIT:
+	case FICL_VM_STATUS_QUIT:
+	case FICL_VM_STATUS_ERROR_EXIT:
+	case FICL_VM_STATUS_ABORT:
+	case FICL_VM_STATUS_ABORTQ:
+	default:		/* user defined exit code?? */
+		if (oldState) {
+			vm->exceptionHandler = oldState;
+			ficlVmThrow(vm, except);
+		}
+	break;
+	}
+
+	vm->exceptionHandler = oldState;
+	vm->runningWord = oldRunningWord;
+	return (except);
+}
+
+/*
+ * f i c l P a r s e N u m b e r
+ * Attempts to convert the NULL terminated string in the VM's pad to
+ * a number using the VM's current base. If successful, pushes the number
+ * onto the param stack and returns FICL_TRUE. Otherwise, returns FICL_FALSE.
+ * (jws 8/01) Trailing decimal point causes a zero ficlCell to be pushed. (See
+ * the standard for DOUBLE wordset.
+ */
+int
+ficlVmParseNumber(ficlVm *vm, ficlString s)
+{
+	ficlInteger accumulator = 0;
+	char isNegative = 0;
+	char isDouble = 0;
+	unsigned base = vm->base;
+	char *trace = FICL_STRING_GET_POINTER(s);
+	ficlUnsigned8 length = (ficlUnsigned8)FICL_STRING_GET_LENGTH(s);
+	unsigned c;
+	unsigned digit;
+
+	if (length > 1) {
+		switch (*trace) {
+		case '-':
+			trace++;
+			length--;
+			isNegative = 1;
+		break;
+		case '+':
+			trace++;
+			length--;
+			isNegative = 0;
+		break;
+		default:
+		break;
+		}
+	}
+
+	/* detect & remove trailing decimal */
+	if ((length > 0) && (trace[length - 1] == '.')) {
+		isDouble = 1;
+		length--;
+	}
+
+	if (length == 0)		/* detect "+", "-", ".", "+." etc */
+		return (0);		/* false */
+
+	while ((length--) && ((c = *trace++) != '\0')) {
+		if (!isalnum(c))
+			return (0);	/* false */
+
+		digit = c - '0';
+
+		if (digit > 9)
+			digit = tolower(c) - 'a' + 10;
+
+		if (digit >= base)
+			return (0);	/* false */
+
+		accumulator = accumulator * base + digit;
+	}
+
+	if (isNegative)
+		accumulator = -accumulator;
+
+	ficlStackPushInteger(vm->dataStack, accumulator);
+	if (vm->state == FICL_VM_STATE_COMPILE)
+		ficlPrimitiveLiteralIm(vm);
+
+	if (isDouble) {			/* simple (required) DOUBLE support */
+		if (isNegative)
+			ficlStackPushInteger(vm->dataStack, -1);
+		else
+			ficlStackPushInteger(vm->dataStack, 0);
+		if (vm->state == FICL_VM_STATE_COMPILE)
+			ficlPrimitiveLiteralIm(vm);
+	}
+
+	return (1); /* true */
+}
+
+/*
+ * d i c t C h e c k
+ * Checks the dictionary for corruption and throws appropriate
+ * errors.
+ * Input: +n number of ADDRESS UNITS (not ficlCells) proposed to allot
+ *        -n number of ADDRESS UNITS proposed to de-allot
+ *         0 just do a consistency check
+ */
+void
+ficlVmDictionarySimpleCheck(ficlVm *vm, ficlDictionary *dictionary, int cells)
+{
+#if FICL_ROBUST >= 1
+	if ((cells >= 0) &&
+	    (ficlDictionaryCellsAvailable(dictionary) *
+	    (int)sizeof (ficlCell) < cells)) {
+		ficlVmThrowError(vm, "Error: dictionary full");
+	}
+
+	if ((cells <= 0) &&
+	    (ficlDictionaryCellsUsed(dictionary) *
+	    (int)sizeof (ficlCell) < -cells)) {
+		ficlVmThrowError(vm, "Error: dictionary underflow");
+	}
+#else /* FICL_ROBUST >= 1 */
+	FICL_IGNORE(vm);
+	FICL_IGNORE(dictionary);
+	FICL_IGNORE(cells);
+#endif /* FICL_ROBUST >= 1 */
+}
+
+void
+ficlVmDictionaryCheck(ficlVm *vm, ficlDictionary *dictionary, int cells)
+{
+#if FICL_ROBUST >= 1
+	ficlVmDictionarySimpleCheck(vm, dictionary, cells);
+
+	if (dictionary->wordlistCount > FICL_MAX_WORDLISTS) {
+		ficlDictionaryResetSearchOrder(dictionary);
+		ficlVmThrowError(vm, "Error: search order overflow");
+	} else if (dictionary->wordlistCount < 0) {
+		ficlDictionaryResetSearchOrder(dictionary);
+		ficlVmThrowError(vm, "Error: search order underflow");
+	}
+#else /* FICL_ROBUST >= 1 */
+	FICL_IGNORE(vm);
+	FICL_IGNORE(dictionary);
+	FICL_IGNORE(cells);
+#endif /* FICL_ROBUST >= 1 */
+}
+
+void
+ficlVmDictionaryAllot(ficlVm *vm, ficlDictionary *dictionary, int n)
+{
+	FICL_VM_DICTIONARY_SIMPLE_CHECK(vm, dictionary, n);
+	FICL_IGNORE(vm);
+	ficlDictionaryAllot(dictionary, n);
+}
+
+void
+ficlVmDictionaryAllotCells(ficlVm *vm, ficlDictionary *dictionary, int cells)
+{
+	FICL_VM_DICTIONARY_SIMPLE_CHECK(vm, dictionary, cells);
+	FICL_IGNORE(vm);
+	ficlDictionaryAllotCells(dictionary, cells);
+}
+
+/*
+ * f i c l P a r s e W o r d
+ * From the standard, section 3.4
+ * b) Search the dictionary name space (see 3.4.2). If a definition name
+ * matching the string is found:
+ *  1.if interpreting, perform the interpretation semantics of the definition
+ *  (see 3.4.3.2), and continue at a);
+ *  2.if compiling, perform the compilation semantics of the definition
+ *  (see 3.4.3.3), and continue at a).
+ *
+ * c) If a definition name matching the string is not found, attempt to
+ * convert the string to a number (see 3.4.1.3). If successful:
+ *  1.if interpreting, place the number on the data stack, and continue at a);
+ *  2.if compiling, FICL_VM_STATE_COMPILE code that when executed will place
+ *  the number on the stack (see 6.1.1780 LITERAL), and continue at a);
+ *
+ * d) If unsuccessful, an ambiguous condition exists (see 3.4.4).
+ *
+ * (jws 4/01) Modified to be a ficlParseStep
+ */
+int
+ficlVmParseWord(ficlVm *vm, ficlString name)
+{
+	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+	ficlWord *tempFW;
+
+	FICL_VM_DICTIONARY_CHECK(vm, dictionary, 0);
+	FICL_STACK_CHECK(vm->dataStack, 0, 0);
+
+#if FICL_WANT_LOCALS
+	if (vm->callback.system->localsCount > 0) {
+		tempFW = ficlSystemLookupLocal(vm->callback.system, name);
+	} else
+#endif
+		tempFW = ficlDictionaryLookup(dictionary, name);
+
+	if (vm->state == FICL_VM_STATE_INTERPRET) {
+		if (tempFW != NULL) {
+			if (ficlWordIsCompileOnly(tempFW)) {
+				ficlVmThrowError(vm,
+				    "Error: FICL_VM_STATE_COMPILE only!");
+			}
+
+			ficlVmExecuteWord(vm, tempFW);
+			return (1); /* true */
+		}
+	} else {	/* (vm->state == FICL_VM_STATE_COMPILE) */
+		if (tempFW != NULL) {
+			if (ficlWordIsImmediate(tempFW)) {
+				ficlVmExecuteWord(vm, tempFW);
+			} else {
+				ficlCell c;
+				c.p = tempFW;
+				if (tempFW->flags & FICL_WORD_INSTRUCTION)
+					ficlDictionaryAppendUnsigned(dictionary,
+					    (ficlInteger)tempFW->code);
+				else
+					ficlDictionaryAppendCell(dictionary, c);
+			}
+			return (1); /* true */
+		}
+	}
+
+	return (0); /* false */
+}
diff --git a/usr/src/common/ficl/word.c b/usr/src/common/ficl/word.c
new file mode 100644
index 0000000000..3d4da1b25a
--- /dev/null
+++ b/usr/src/common/ficl/word.c
@@ -0,0 +1,136 @@
+#include "ficl.h"
+
+/*
+ * w o r d I s I m m e d i a t e
+ */
+int
+ficlWordIsImmediate(ficlWord *word)
+{
+	return ((word != NULL) && (word->flags & FICL_WORD_IMMEDIATE));
+}
+
+/*
+ * w o r d I s C o m p i l e O n l y
+ */
+int
+ficlWordIsCompileOnly(ficlWord *word)
+{
+	return ((word != NULL) && (word->flags & FICL_WORD_COMPILE_ONLY));
+}
+
+/*
+ * f i c l W o r d C l a s s i f y
+ * This public function helps to classify word types for SEE
+ * and the debugger in tools.c. Given an pointer to a word, it returns
+ * a member of WOR
+ */
+ficlWordKind
+ficlWordClassify(ficlWord *word)
+{
+	ficlPrimitive code;
+	ficlInstruction i;
+	ficlWordKind iType;
+
+	if ((((ficlInstruction)word) > ficlInstructionInvalid) &&
+	    (((ficlInstruction)word) < ficlInstructionLast)) {
+		i = (ficlInstruction)word;
+		iType = FICL_WORDKIND_INSTRUCTION;
+		goto IS_INSTRUCTION;
+	}
+
+	code = word->code;
+
+	if ((((ficlInstruction)code) > ficlInstructionInvalid) &&
+	    (((ficlInstruction)code) < ficlInstructionLast)) {
+		i = (ficlInstruction)code;
+		iType = FICL_WORDKIND_INSTRUCTION_WORD;
+		goto IS_INSTRUCTION;
+	}
+
+	return (FICL_WORDKIND_PRIMITIVE);
+
+IS_INSTRUCTION:
+
+	switch (i) {
+	case ficlInstructionConstantParen:
+#if FICL_WANT_FLOAT
+	case ficlInstructionFConstantParen:
+#endif /* FICL_WANT_FLOAT */
+	return (FICL_WORDKIND_CONSTANT);
+
+	case ficlInstruction2ConstantParen:
+#if FICL_WANT_FLOAT
+	case ficlInstructionF2ConstantParen:
+#endif /* FICL_WANT_FLOAT */
+	return (FICL_WORDKIND_2CONSTANT);
+
+#if FICL_WANT_LOCALS
+	case ficlInstructionToLocalParen:
+	case ficlInstructionTo2LocalParen:
+#if FICL_WANT_FLOAT
+	case ficlInstructionToFLocalParen:
+	case ficlInstructionToF2LocalParen:
+#endif /* FICL_WANT_FLOAT */
+	return (FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT);
+#endif /* FICL_WANT_LOCALS */
+
+#if FICL_WANT_USER
+	case ficlInstructionUserParen:
+	return (FICL_WORDKIND_USER);
+#endif
+
+	case ficlInstruction2LiteralParen:
+	return (FICL_WORDKIND_2LITERAL);
+
+#if FICL_WANT_FLOAT
+	case ficlInstructionFLiteralParen:
+	return (FICL_WORDKIND_FLITERAL);
+#endif
+	case ficlInstructionCreateParen:
+	return (FICL_WORDKIND_CREATE);
+
+	case ficlInstructionCStringLiteralParen:
+	return (FICL_WORDKIND_CSTRING_LITERAL);
+
+	case ficlInstructionStringLiteralParen:
+	return (FICL_WORDKIND_STRING_LITERAL);
+
+	case ficlInstructionColonParen:
+	return (FICL_WORDKIND_COLON);
+
+	case ficlInstructionDoDoes:
+	return (FICL_WORDKIND_DOES);
+
+	case ficlInstructionDoParen:
+	return (FICL_WORDKIND_DO);
+
+	case ficlInstructionQDoParen:
+	return (FICL_WORDKIND_QDO);
+
+	case ficlInstructionVariableParen:
+	return (FICL_WORDKIND_VARIABLE);
+
+	case ficlInstructionBranchParenWithCheck:
+	case ficlInstructionBranchParen:
+	return (FICL_WORDKIND_BRANCH);
+
+	case ficlInstructionBranch0ParenWithCheck:
+	case ficlInstructionBranch0Paren:
+	return (FICL_WORDKIND_BRANCH0);
+
+	case ficlInstructionLiteralParen:
+	return (FICL_WORDKIND_LITERAL);
+
+	case ficlInstructionLoopParen:
+	return (FICL_WORDKIND_LOOP);
+
+	case ficlInstructionOfParen:
+	return (FICL_WORDKIND_OF);
+
+	case ficlInstructionPlusLoopParen:
+	return (FICL_WORDKIND_PLOOP);
+
+	default:
+	return (iType);
+	}
+}
diff --git a/usr/src/lib/Makefile b/usr/src/lib/Makefile
index 5af6a5dbf3..d5caff124f 100644
--- a/usr/src/lib/Makefile
+++ b/usr/src/lib/Makefile
@@ -27,6 +27,7 @@
 # Copyright 2014 Garrett D'Amore <garrett@damore.org>
 # Copyright (c) 2015 Gary Mills
 # Copyright 2015 Nexenta Systems, Inc.  All rights reserved.
+# Copyright 2016 Toomas Soome <tsoome@me.com>
 #
 
 include ../Makefile.master
@@ -124,6 +125,7 @@ SUBDIRS +=				\
 	libexacct/demo	\
 	libfakekernel	\
 	libfcoe		\
+	libficl		\
 	libfru		\
 	libfruutils	\
 	libfsmgt	\
@@ -606,6 +608,7 @@ libeti:		libcurses
 libexacct/demo:	libexacct libproject
 libfakekernel:	libumem libcryptoutil
 libfcoe:	libdladm
+libficl:	libumem
 libfru:		libfruutils
 libfsmgt:	libkstat
 libgrubmgmt:	libdevinfo libzfs libfstyp libefi
diff --git a/usr/src/lib/libficl/Makefile b/usr/src/lib/libficl/Makefile
new file mode 100644
index 0000000000..c29321843f
--- /dev/null
+++ b/usr/src/lib/libficl/Makefile
@@ -0,0 +1,48 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include		../Makefile.lib
+
+HDRS=		ficllocal.h
+
+HDRDIR=		$(SRC)/common/ficl
+
+SUBDIRS=	softcore $(MACH)
+$(BUILD64)SUBDIRS += $(MACH64)
+
+all :=		TARGET= all
+clean :=	TARGET= clean
+clobber :=	TARGET= clobber
+install :=	TARGET= install
+
+.KEEP_STATE:
+
+all install: install_h $(SUBDIRS)
+
+clean clobber: $(SUBDIRS)
+
+install_h:	$(PLATHDRDIR) $(ROOTHDRS)
+
+check:		$(CHECKHDRS)
+
+$(SUBDIRS): FRC
+	@cd $@; pwd; $(MAKE) $(TARGET)
+
+$(ROOTHDRDIR)/%: ./%
+	$(INS.file)
+
+FRC:
+
+include $(SRC)/lib/Makefile.targ
diff --git a/usr/src/lib/libficl/Makefile.com b/usr/src/lib/libficl/Makefile.com
new file mode 100644
index 0000000000..a2c37d27c2
--- /dev/null
+++ b/usr/src/lib/libficl/Makefile.com
@@ -0,0 +1,63 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+LIBRARY=libficl-sys.a
+MAJOR = 4
+MINOR = 1.0
+VERS=.$(MAJOR).$(MINOR)
+
+OBJECTS= dictionary.o system.o fileaccess.o float.o double.o prefix.o search.o \
+	softcore.o stack.o tools.o vm.o primitives.o unix.o utility.o \
+	hash.o callback.o word.o loader.o pager.o extras.o \
+	loader_emu.o lz4.o
+
+include $(SRC)/lib/Makefile.lib
+
+LIBS=	$(DYNLIB) $(LINTLIB)
+
+FICLDIR=	$(SRC)/common/ficl
+C99MODE=	$(C99_ENABLE)
+CPPFLAGS +=	-I.. -I$(FICLDIR) -D_LARGEFILE64_SOURCE=1
+
+LDLIBS +=	-lc -lm -lumem
+
+HEADERS= $(FICLDIR)/ficl.h $(FICLDIR)/ficltokens.h ../ficllocal.h \
+	$(FICLDIR)/ficlplatform/unix.h
+
+pics/%.o:	../softcore/%.c $(HEADERS)
+	$(COMPILE.c) -o $@ $<
+	$(POST_PROCESS_O)
+
+pics/%.o:	$(FICLDIR)/%.c $(HEADERS)
+	$(COMPILE.c) -o $@ $<
+	$(POST_PROCESS_O)
+
+pics/%.o:	$(FICLDIR)/ficlplatform/%.c $(HEADERS)
+	$(COMPILE.c) -o $@ $<
+	$(POST_PROCESS_O)
+
+pics/%.o:	$(FICLDIR)/emu/%.c $(HEADERS)
+	$(COMPILE.c) -o $@ $<
+	$(POST_PROCESS_O)
+
+pics/%.o:	$(FICLDIR)/softcore/%.c $(HEADERS)
+	$(COMPILE.c) -o $@ $<
+	$(POST_PROCESS_O)
+
+$(LINTLIB) := SRCS=	../$(LINTSRC)
+
+all: $(LIBS)
+
+include $(SRC)/lib/Makefile.targ
diff --git a/usr/src/lib/libficl/amd64/Makefile b/usr/src/lib/libficl/amd64/Makefile
new file mode 100644
index 0000000000..1cac1cfedd
--- /dev/null
+++ b/usr/src/lib/libficl/amd64/Makefile
@@ -0,0 +1,19 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include ../Makefile.com
+include ../../Makefile.lib.64
+
+install: all $(ROOTLIBS64) $(ROOTLINKS64) $(ROOTLINT64)
diff --git a/usr/src/lib/libficl/ficllocal.h b/usr/src/lib/libficl/ficllocal.h
new file mode 100644
index 0000000000..a5449464d2
--- /dev/null
+++ b/usr/src/lib/libficl/ficllocal.h
@@ -0,0 +1,35 @@
+/*
+ * This file and its contents are supplied under the terms of the
+ * Common Development and Distribution License ("CDDL"), version 1.0.
+ * You may only use this file in accordance with the terms of version
+ * 1.0 of the CDDL.
+ *
+ * A full copy of the text of the CDDL should have accompanied this
+ * source.  A copy of the CDDL is also available via the Internet at
+ * http://www.illumos.org/license/CDDL.
+ */
+
+/*
+ * Copyright 2016 Toomas Soome <tsoome@me.com>
+ */
+
+#ifndef _FICLLOCAL_H
+#define	_FICLLOCAL_H
+
+/*
+ *	ficllocal.h
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Put all local settings here.  This file will always ship empty.
+ */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _FICLLOCAL_H */
diff --git a/usr/src/lib/libficl/i386/Makefile b/usr/src/lib/libficl/i386/Makefile
new file mode 100644
index 0000000000..ae94623a64
--- /dev/null
+++ b/usr/src/lib/libficl/i386/Makefile
@@ -0,0 +1,18 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include ../Makefile.com
+
+install: all $(ROOTLIBS) $(ROOTLINKS) $(ROOTLINT)
diff --git a/usr/src/lib/libficl/llib-lficl-sys b/usr/src/lib/libficl/llib-lficl-sys
new file mode 100644
index 0000000000..77d9e45d72
--- /dev/null
+++ b/usr/src/lib/libficl/llib-lficl-sys
@@ -0,0 +1,20 @@
+/*
+ * This file and its contents are supplied under the terms of the
+ * Common Development and Distribution License ("CDDL"), version 1.0.
+ * You may only use this file in accordance with the terms of version
+ * 1.0 of the CDDL.
+ *
+ * A full copy of the text of the CDDL should have accompanied this
+ * source.  A copy of the CDDL is also available via the Internet at
+ * http://www.illumos.org/license/CDDL.
+ */
+
+/*
+ * Copyright 2016 Toomas Soome <tsoome@me.com>
+ */
+
+/*LINTLIBRARY*/
+/*PROTOLIB1*/
+
+#include <ficl.h>
+#include <ficlplatform/emu.h>
diff --git a/usr/src/lib/libficl/mapfile-vers b/usr/src/lib/libficl/mapfile-vers
new file mode 100644
index 0000000000..acb556e223
--- /dev/null
+++ b/usr/src/lib/libficl/mapfile-vers
@@ -0,0 +1,204 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright (c) 2016, Toomas Soome <tsoome@me.com>
+#
+
+#
+# MAPFILE HEADER START
+#
+# WARNING:  STOP NOW.  DO NOT MODIFY THIS FILE.
+# Object versioning must comply with the rules detailed in
+#
+#	usr/src/lib/README.mapfiles
+#
+# You should not be making modifications here until you've read the most current
+# copy of that file. If you need help, contact a gatekeeper for guidance.
+#
+# MAPFILE HEADER END
+#
+
+# NOTE: libficl should be kept in sync with interfaces used in standalone
+# ficl in loader, so we can use this library to verify loader functionality.
+
+$mapfile_version 2
+
+SYMBOL_VERSION ILLUMOSprivate {
+    global:
+	bf_init;
+	bf_fini;
+	bf_run;
+	ficl2IntegerDivideFloored;
+	ficl2IntegerDivideSymmetric;
+	ficl2UnsignedDivide;
+	ficlAlignPointer;
+	ficlCallbackAssert;
+	ficlCallbackDefaultTextOut;
+	ficlCallbackTextOut;
+	ficlDictionaryAbortDefinition;
+	ficlDictionaryAlign;
+	ficlDictionaryAllot;
+	ficlDictionaryAllotCells;
+	ficlDictionaryAppend2Constant;
+	ficlDictionaryAppend2ConstantInstruction;
+	ficlDictionaryAppendCell;
+	ficlDictionaryAppendCharacter;
+	ficlDictionaryAppendConstant;
+	ficlDictionaryAppendConstantInstruction;
+	ficlDictionaryAppendData;
+	ficlDictionaryAppendInstruction;
+	ficlDictionaryAppendPrimitive;
+	ficlDictionaryAppendString;
+	ficlDictionaryAppendUnsigned;
+	ficlDictionaryAppendWord;
+	ficlDictionaryCellsAvailable;
+	ficlDictionaryCellsUsed;
+	ficlDictionaryClearFlags;
+	ficlDictionaryCreate;
+	ficlDictionaryCreateHashed;
+	ficlDictionaryCreateWordlist;
+	ficlDictionaryDestroy;
+	ficlDictionaryEmpty;
+	ficlDictionaryFindEnclosingWord;
+	ficlDictionaryIncludes;
+	ficlDictionaryIsAWord;
+	ficlDictionaryLookup;
+	ficlDictionaryResetSearchOrder;
+	ficlDictionarySee;
+	ficlDictionarySet2Constant;
+	ficlDictionarySet2ConstantInstruction;
+	ficlDictionarySetConstant;
+	ficlDictionarySetConstantInstruction;
+	ficlDictionarySetFlags;
+	ficlDictionarySetImmediate;
+	ficlDictionarySetInstruction;
+	ficlDictionarySetPrimitive;
+	ficlDictionaryUnsmudge;
+	ficlDictionaryWhere;
+	ficlDigitToCharacter;
+	ficlFree;
+	ficlHashCode;
+	ficlHashForget;
+	ficlHashInsertWord;
+	ficlHashLookup;
+	ficlHashReset;
+	ficlIsPowerOfTwo;
+	ficlLocalParen;
+	ficlLocalParenIm;
+	ficlLtoa;
+	ficlMalloc;
+	ficlPrimitiveHashSummary;
+	ficlPrimitiveLiteralIm;
+	ficlPrimitiveParseStepParen;
+	ficlPrimitiveTick;
+	ficlRealloc;
+	ficlStackCheck;
+	ficlStackCreate;
+	ficlStackDepth;
+	ficlStackDestroy;
+	ficlStackWalk;
+	ficlStackDisplay;
+	ficlStackDrop;
+	ficlStackFetch;
+	ficlStackGetTop;
+	ficlStackLink;
+	ficlStackPick;
+	ficlStackPop;
+	ficlStackPop2Integer;
+	ficlStackPop2Unsigned;
+	ficlStackPopFloat;
+	ficlStackPopInteger;
+	ficlStackPopPointer;
+	ficlStackPopUnsigned;
+	ficlStackPush;
+	ficlStackPush2Integer;
+	ficlStackPush2Unsigned;
+	ficlStackPushFloat;
+	ficlStackPushInteger;
+	ficlStackPushPointer;
+	ficlStackPushUnsigned;
+	ficlStackReset;
+	ficlStackRoll;
+	ficlStackSetTop;
+	ficlStackStore;
+	ficlStackUnlink;
+	ficlStrincmp;
+	ficlStringCaseFold;
+	ficlStringReverse;
+	ficlStringSkipSpace;
+	ficlSystemAddParseStep;
+	ficlSystemAddPrimitiveParseStep;
+	ficlSystemCompileCore;
+	ficlSystemCompileExtras;
+	ficlSystemCompileFile;
+	ficlSystemCompileFloat;
+	ficlSystemCompilePlatform;
+	ficlSystemCompilePrefix;
+	ficlSystemCompileSearch;
+	ficlSystemCompileSoftCore;
+	ficlSystemCompileTools;
+	ficlSystemCreate;
+	ficlSystemCreateVm;
+	ficlSystemDestroy;
+	ficlSystemDestroyVm;
+	ficlSystemGetDictionary;
+	ficlSystemGetEnvironment;
+	ficlSystemGetLocals;
+	ficlSystemLookup;
+	ficlSystemLookupLocal;
+	ficlUltoa;
+	ficlVmBranchRelative;
+	ficlVmCreate;
+	ficlVmDestroy;
+	ficlVmDictionaryAllot;
+	ficlVmDictionaryAllotCells;
+	ficlVmDictionaryCheck;
+	ficlVmDictionarySimpleCheck;
+	ficlVmDisplayDataStack;
+	ficlVmDisplayDataStackSimple;
+	ficlVmDisplayFloatStack;
+	ficlVmDisplayReturnStack;
+	ficlVmEvaluate;
+	ficlVmExecuteString;
+	ficlVmExecuteWord;
+	ficlVmExecuteXT;
+	ficlVmGetDictionary;
+	ficlVmGetString;
+	ficlVmGetWord;
+	ficlVmGetWord0;
+	ficlVmGetWordToPad;
+	ficlVmInnerLoop;
+	ficlVmParseFloatNumber;
+	ficlVmParseNumber;
+	ficlVmParseString;
+	ficlVmParseStringEx;
+	ficlVmParseWord;
+	ficlVmParsePrefix;
+	ficlVmPop;
+	ficlVmPopIP;
+	ficlVmPopTib;
+	ficlVmPush;
+	ficlVmPushIP;
+	ficlVmPushTib;
+	ficlVmQuit;
+	ficlVmReset;
+	ficlVmSetTextOut;
+	ficlVmTextOut;
+	ficlVmThrow;
+	ficlVmThrowError;
+	ficlWordClassify;
+	ficlWordIsCompileOnly;
+	ficlWordIsImmediate;
+
+    local:
+	*;
+};
diff --git a/usr/src/lib/libficl/softcore/Makefile b/usr/src/lib/libficl/softcore/Makefile
new file mode 100644
index 0000000000..a1cec6287f
--- /dev/null
+++ b/usr/src/lib/libficl/softcore/Makefile
@@ -0,0 +1,46 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include $(SRC)/tools/Makefile.tools
+
+install all: softcore.c
+
+SOFTCORE=	$(SRC)/common/ficl/softcore
+PROG =	makesoftcore
+
+#
+# not needed: file access
+#
+FR = softcore.fr ifbrack.fr prefix.fr ficl.fr jhlocal.fr marker.fr
+FR += freebsd.fr ficllocal.fr oo.fr classes.fr string.fr
+SOURCES=	$(FR:%=$(SOFTCORE)/%)
+
+OBJS=	makesoftcore.o lz4.o
+SRCS=	makesoftcore.c lz4.c
+LDLIBS= -lumem
+
+CPPFLAGS += -I.. -I$(SRC)/common/ficl
+
+softcore.c: $(PROG) $(SOURCES)
+	./$(PROG) $(SOURCES)
+
+$(PROG): $(OBJS)
+	$(LINK.c) -o $@ $(OBJS) $(LDLIBS)
+
+%.o: $(SOFTCORE)/%.c
+	$(COMPILE.c) $<
+
+clobber clean:
+	$(RM) softcore.c $(OBJS) $(PROG)
diff --git a/usr/src/lib/libficl/sparc/Makefile b/usr/src/lib/libficl/sparc/Makefile
new file mode 100644
index 0000000000..ae94623a64
--- /dev/null
+++ b/usr/src/lib/libficl/sparc/Makefile
@@ -0,0 +1,18 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include ../Makefile.com
+
+install: all $(ROOTLIBS) $(ROOTLINKS) $(ROOTLINT)
diff --git a/usr/src/lib/libficl/sparcv9/Makefile b/usr/src/lib/libficl/sparcv9/Makefile
new file mode 100644
index 0000000000..1cac1cfedd
--- /dev/null
+++ b/usr/src/lib/libficl/sparcv9/Makefile
@@ -0,0 +1,19 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016 Toomas Soome <tsoome@me.com>
+#
+
+include ../Makefile.com
+include ../../Makefile.lib.64
+
+install: all $(ROOTLIBS64) $(ROOTLINKS64) $(ROOTLINT64)
diff --git a/usr/src/pkg/manifests/system-ficl.mf b/usr/src/pkg/manifests/system-ficl.mf
new file mode 100644
index 0000000000..dc4dd69270
--- /dev/null
+++ b/usr/src/pkg/manifests/system-ficl.mf
@@ -0,0 +1,39 @@
+#
+# This file and its contents are supplied under the terms of the
+# Common Development and Distribution License ("CDDL"), version 1.0.
+# You may only use this file in accordance with the terms of version
+# 1.0 of the CDDL.
+#
+# A full copy of the text of the CDDL should have accompanied this
+# source.  A copy of the CDDL is also available via the Internet at
+# http://www.illumos.org/license/CDDL.
+#
+
+#
+# Copyright 2016, Toomas Soome <tsoome@me.com>
+#
+
+#
+# The default for payload-bearing actions in this package is to appear in the
+# global zone only.  See the include file for greater detail, as well as
+# information about overriding the defaults.
+#
+set name=pkg.fmri \
+    value=pkg:/system/ficl@4.1.0,$(PKGVERS_BUILTON)-$(PKGVERS_BRANCH)
+set name=pkg.description value="Forth Inspired Command Language"
+set name=pkg.summary value="FICL Forth Implementation"
+set name=info.classification value=org.opensolaris.category.2008:System/Core
+set name=variant.arch value=$(ARCH)
+dir path=usr group=sys
+dir path=usr/bin group=bin
+dir path=usr/bin/$(ARCH32) group=bin
+dir path=usr/bin/$(ARCH64) group=bin
+dir path=usr/lib group=bin
+dir path=usr/lib/$(ARCH64) group=bin
+file path=usr/bin/$(ARCH32)/ficl-sys group=sys mode=0555
+file path=usr/bin/$(ARCH64)/ficl-sys group=sys mode=0555
+file path=usr/lib/$(ARCH64)/libficl-sys.so.4.1.0 group=sys mode=0755
+file path=usr/lib/libficl-sys.so.4.1.0 group=sys mode=0755
+hardlink path=usr/bin/ficl-sys target=../../usr/lib/isaexec
+license lic_CDDL license=lic_CDDL
+license usr/src/common/ficl/LICENSE license=usr/src/common/ficl/LICENSE