[illumos-gate merge]

commit f76886de6cd6914424d9f6c25bd9d93d87889269
    7402 Create tunable to ignore hole_birth feature
commit 5bdf86e2a288d6c81a0bcc50a98699f52557bab6
    7401 loader.4th is missing newline
commit ed4e7a6a5cbc5e8986dc649ad54435210487b102
    7340 receive manual origin should override automatic origin
commit b021ac0b78f8df3d9c421783d9a323723df84925
    7337 inherit_001_pos occasionally times out
commit c166b69d29138aed7a415fe7cef698e54c6ae945
    7254 ztest failed assertion in ztest_dataset_dirobj_verify: dirobjs + 1 == usedobjs
commit 754998c8d410b7b7ddefbfa4de310a030e0c7ce1
    7253 ztest failure: dsl_destroy_head(name) == 0 (0x10 == 0x0), file ../ztest.c, line 3235
commit 4220fdc152e5dfec9a1dd51452175295f3684689
    7398 zfs test zfs_get_005_neg does not work as expected
commit d5f26ad8122c3762fb16413a17bfb497db86a782
    5142 libzfs support raidz root pool (loader project)
commit c8811bd3e2427dddbac6c05a59cfe117d8fea370
    5120 zfs should allow large block/gzip/raidz boot pool (loader project)
commit 12e3fba22ec759e9dd8f9564fad79541275b2aa5
    6709 manual pages need to be updated for loader (loader project)
commit fa0c327afe484fa5ff164fb81ff93715dd6573f8
    6706 disable grub menu management in bootadm (loader project)
    6707 disable grub menu management in libbe (loader project)
commit 9abc7a578aecf9064f46563361e8f856b4bdc35e
    6705 halt: replace grub_get_boot_args with be_get_boot_args (loader project)
commit a6424c753d6e2f0f04fb65b11e9f9c04445ccbae
    6704 svc.startd: replace grub_get_boot_args with be_get_boot_args (loader project)
commit c262cbbc8301f7c884fd4800056ee51ba75d931c
    6703 update bootadm to support loader configuration (loader project)
    6708 update eeprom for loader (loader project)
commit ce3cb817f67103796b730fd322174dddefd9a9a8
    6702 libbe should support x86 installboot command (loader project)
commit 0c946d80993858b7b1314e0b31773e48500e03fb
    6701 add installboot to i386 platform (loader project)
commit 1386b601c0c7f5c89a9325b8a1e34037304e8119
    6700 remove installboot script from i386 platform (loader project)
commit f5e5a2c4965aa1013184568ca3140cdcba93e44b
    6699 be_get_boot_args interface implementation in libbe (loader project)
commit 199767f8919635c4928607450d9e0abb932109ce
    5061 freebsd boot loader integration (loader project)
commit 0cc5983c8a077e6396dc7c492ee928b40bf0fed1
    6698 freebsd btxld port for illumos (loader project)
commit afc2ba1deb75b323afde536f2dd18bcafdaa308d
    6185 want ficl scripting engine in illumos (loader project)

	Conflicts:
	exception_lists/cstyle
	exception_lists/hdrchk
	exception_lists/copyright

1 files changed, 949 insertions, 0 deletions

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
+}