socsvn commit: r287740 - in soc2015/clord/head/sys/contrib/ficl: . contrib ficlplatform softcore softwords

clord at FreeBSD.org clord at FreeBSD.org
Mon Jun 29 19:39:57 UTC 2015


Author: clord
Date: Mon Jun 29 19:39:54 2015
New Revision: 287740
URL: http://svnweb.FreeBSD.org/socsvn/?view=rev&rev=287740

Log:
  Import Ficl 4 sources second attempt

Added:
  soc2015/clord/head/sys/contrib/ficl/Makefile
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/Makefile
  soc2015/clord/head/sys/contrib/ficl/bit.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/bit.c
  soc2015/clord/head/sys/contrib/ficl/callback.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/callback.c
  soc2015/clord/head/sys/contrib/ficl/compatibility.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/compatibility.c
  soc2015/clord/head/sys/contrib/ficl/contrib/
     - copied from r285383, mirror/FreeBSD/vendor/ficl/dist/contrib/
  soc2015/clord/head/sys/contrib/ficl/dictionary.c
     - copied unchanged from r287721, soc2015/clord/head/sys/contrib/ficl/dict.c
  soc2015/clord/head/sys/contrib/ficl/double.c
     - copied unchanged from r287721, soc2015/clord/head/sys/contrib/ficl/math64.c
  soc2015/clord/head/sys/contrib/ficl/extras.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/extras.c
  soc2015/clord/head/sys/contrib/ficl/ficlcompatibility.h
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/ficlcompatibility.h
  soc2015/clord/head/sys/contrib/ficl/ficldll.def
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/ficldll.def
  soc2015/clord/head/sys/contrib/ficl/ficldll.dsp
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/ficldll.dsp
  soc2015/clord/head/sys/contrib/ficl/ficlexe.dsp
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/ficlexe.dsp
  soc2015/clord/head/sys/contrib/ficl/ficllib.dsp
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/ficllib.dsp
  soc2015/clord/head/sys/contrib/ficl/ficllocal.h
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/ficllocal.h
  soc2015/clord/head/sys/contrib/ficl/ficlplatform/
     - copied from r285383, mirror/FreeBSD/vendor/ficl/dist/ficlplatform/
  soc2015/clord/head/sys/contrib/ficl/ficltokens.h
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/ficltokens.h
  soc2015/clord/head/sys/contrib/ficl/hash.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/hash.c
  soc2015/clord/head/sys/contrib/ficl/lzcompress.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/lzcompress.c
  soc2015/clord/head/sys/contrib/ficl/lzuncompress.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/lzuncompress.c
  soc2015/clord/head/sys/contrib/ficl/main.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/main.c
  soc2015/clord/head/sys/contrib/ficl/primitives.c
     - copied unchanged from r287721, soc2015/clord/head/sys/contrib/ficl/words.c
  soc2015/clord/head/sys/contrib/ficl/softcore/   (props changed)
     - copied from r287721, soc2015/clord/head/sys/contrib/ficl/softwords/
  soc2015/clord/head/sys/contrib/ficl/system.c
     - copied unchanged from r287721, soc2015/clord/head/sys/contrib/ficl/ficl.c
  soc2015/clord/head/sys/contrib/ficl/utility.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/utility.c
  soc2015/clord/head/sys/contrib/ficl/word.c
     - copied unchanged from r285383, mirror/FreeBSD/vendor/ficl/dist/word.c
Deleted:
  soc2015/clord/head/sys/contrib/ficl/dict.c
  soc2015/clord/head/sys/contrib/ficl/ficl.c
  soc2015/clord/head/sys/contrib/ficl/math64.c
  soc2015/clord/head/sys/contrib/ficl/math64.h
  soc2015/clord/head/sys/contrib/ficl/softwords/
  soc2015/clord/head/sys/contrib/ficl/testmain.c
  soc2015/clord/head/sys/contrib/ficl/unix.c
  soc2015/clord/head/sys/contrib/ficl/words.c
Modified:
  soc2015/clord/head/sys/contrib/ficl/   (props changed)
  soc2015/clord/head/sys/contrib/ficl/ReadMe.txt
  soc2015/clord/head/sys/contrib/ficl/ficl.h
  soc2015/clord/head/sys/contrib/ficl/fileaccess.c
  soc2015/clord/head/sys/contrib/ficl/float.c
  soc2015/clord/head/sys/contrib/ficl/prefix.c
  soc2015/clord/head/sys/contrib/ficl/search.c
  soc2015/clord/head/sys/contrib/ficl/stack.c
  soc2015/clord/head/sys/contrib/ficl/tools.c
  soc2015/clord/head/sys/contrib/ficl/vm.c

Copied: soc2015/clord/head/sys/contrib/ficl/Makefile (from r285383, mirror/FreeBSD/vendor/ficl/dist/Makefile)
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ soc2015/clord/head/sys/contrib/ficl/Makefile	Mon Jun 29 19:39:54 2015	(r287740, copy of r285383, mirror/FreeBSD/vendor/ficl/dist/Makefile)
@@ -0,0 +1,60 @@
+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 bit.o lzuncompress.o unix.o utility.o hash.o callback.o word.o extras.o
+HEADERS= ficl.h ficlplatform/unix.h
+#
+# Flags for shared library
+#TARGET= -Dlinux  # riscos MOTO_CPU32 
+SHFLAGS = -fPIC
+CFLAGS= -O $(SHFLAGS) -Wall
+CPPFLAGS= $(TARGET) -I.
+CC = cc
+LIB = ar cr
+RANLIB = ranlib
+
+MAJOR = 4
+MINOR = 1.0
+
+ficl: main.o $(HEADERS) libficl.a
+	$(CC) $(CFLAGS) $(LDFLAGS) main.o -o ficl -L. -lficl -lm
+
+lib: libficl.so.$(MAJOR).$(MINOR)
+
+# static library build
+libficl.a: $(OBJECTS)
+	$(LIB) libficl.a $(OBJECTS)
+	$(RANLIB) libficl.a
+
+# shared library build
+libficl.so.$(MAJOR).$(MINOR): $(OBJECTS)
+	$(CC) $(LDFLAGS) -shared -Wl,-soname,libficl.so.$(MAJOR).$(MINOR) \
+	-o libficl.so.$(MAJOR).$(MINOR) $(OBJECTS)
+	ln -sf libficl.so.$(MAJOR).$(MINOR) libficl.so
+
+main: main.o ficl.h sysdep.h libficl.so.$(MAJOR).$(MINOR)
+	$(CC) $(CFLAGS) $(LDFLAGS) main.o -o main -L. -lficl -lm
+	ln -sf libficl.so.$(MAJOR).$(MINOR) libficl.so.$(MAJOR)
+
+# depend explicitly to help finding source files in another subdirectory,
+# and repeat commands since gmake doesn't understand otherwise
+ansi.o: ficlplatform/ansi.c $(HEADERS)
+	$(CC) $(CFLAGS) $(CPPFLAGS) -c -o $@ $<
+unix.o: ficlplatform/unix.c $(HEADERS)
+	$(CC) $(CFLAGS) $(CPPFLAGS) -c -o $@ $<
+
+#
+#       generic object code
+#
+.SUFFIXES: .cxx .cc .c .o
+
+.c.o:
+	$(CC) $(CFLAGS) $(CPPFLAGS) -c -o $@ $<
+
+.cxx.o:
+	$(CPP) $(CXXFLAGS) $(CPPFLAGS) -c -o $@ $<
+
+.cc.o:
+	$(CPP) $(CXXFLAGS) $(CPPFLAGS) -c -o $@ $<
+#
+#       generic cleanup code
+#
+clean:
+	rm -f *.o *.a libficl.* ficl

Modified: soc2015/clord/head/sys/contrib/ficl/ReadMe.txt
==============================================================================
--- soc2015/clord/head/sys/contrib/ficl/ReadMe.txt	Mon Jun 29 19:03:30 2015	(r287739)
+++ soc2015/clord/head/sys/contrib/ficl/ReadMe.txt	Mon Jun 29 19:39:54 2015	(r287740)
@@ -1,5 +1,5 @@
-FICL 3.03
-April 2002
+FICL 4.1.0
+October 2010
 
 ________
 OVERVIEW
@@ -10,18 +10,22 @@
 Command Language".
 
 For more information, please see the "doc" directory.
-For release notes, please see "doc/ficl_rel.html".
+For release notes, please see "doc/releases.html".
 
 ____________
 INSTALLATION
 
 Ficl builds out-of-the-box on the following platforms:
-	* Linux: use "Makefile.linux".
-	* RiscOS: use "Makefile.riscos".
+	* 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, be sure to examine "sysdep.h", and
-we suggest you start with the Linux makefile.  (And please--feel
-free to submit your portability changes!)
+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

Copied: soc2015/clord/head/sys/contrib/ficl/bit.c (from r285383, mirror/FreeBSD/vendor/ficl/dist/bit.c)
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ soc2015/clord/head/sys/contrib/ficl/bit.c	Mon Jun 29 19:39:54 2015	(r287740, copy of r285383, mirror/FreeBSD/vendor/ficl/dist/bit.c)
@@ -0,0 +1,49 @@
+#include "ficl.h"
+
+int ficlBitGet(const unsigned char *bits, size_t index)
+	{
+	int byteIndex = index >> 3;
+	int bitIndex = index & 7;
+	unsigned char mask = (unsigned char)(128 >> bitIndex);
+
+	return ((mask & bits[byteIndex]) ? 1 : 0);
+	}
+
+
+
+void ficlBitSet(unsigned char *bits, size_t index, int value)
+	{
+	int byteIndex = index >> 3;
+	int bitIndex = index & 7;
+	unsigned char mask = (unsigned char)(128 >> bitIndex);
+
+	if (value)
+		bits[byteIndex] |= mask;
+	else
+		bits[byteIndex] &= ~mask;
+	}
+
+
+void ficlBitGetString(unsigned char *destination, const unsigned char *source, int offset, int count, int destAlignment)
+	{
+	int bit = destAlignment - count;
+	while (count--)
+		ficlBitSet(destination, bit++, ficlBitGet(source, offset++));
+	}
+
+
+/*
+** This will actually work correctly *regardless* of the local architecture.
+** --lch
+**/
+ficlUnsigned16 ficlNetworkUnsigned16(ficlUnsigned16 number)
+{
+	ficlUnsigned8 *pointer = (ficlUnsigned8 *)&number;
+	return (ficlUnsigned16)(((ficlUnsigned16)(pointer[0] << 8)) | (pointer[1]));
+}
+
+ficlUnsigned32 ficlNetworkUnsigned32(ficlUnsigned32 number)
+{
+	ficlUnsigned16 *pointer = (ficlUnsigned16 *)&number;
+	return ((ficlUnsigned32)(ficlNetworkUnsigned16(pointer[0]) << 16)) | ficlNetworkUnsigned16(pointer[1]);
+}

Copied: soc2015/clord/head/sys/contrib/ficl/callback.c (from r285383, mirror/FreeBSD/vendor/ficl/dist/callback.c)
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ soc2015/clord/head/sys/contrib/ficl/callback.c	Mon Jun 29 19:39:54 2015	(r287740, copy of r285383, mirror/FreeBSD/vendor/ficl/dist/callback.c)
@@ -0,0 +1,76 @@
+#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);
+
+    return;
+}
+
+
+/**************************************************************************
+                        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);
+
+    return;
+}
+
+

Copied: soc2015/clord/head/sys/contrib/ficl/compatibility.c (from r285383, mirror/FreeBSD/vendor/ficl/dist/compatibility.c)
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ soc2015/clord/head/sys/contrib/ficl/compatibility.c	Mon Jun 29 19:39:54 2015	(r287740, copy of r285383, mirror/FreeBSD/vendor/ficl/dist/compatibility.c)
@@ -0,0 +1,284 @@
+#define FICL_FORCE_COMPATIBILITY 1
+#include "ficl.h"
+
+
+FICL_PLATFORM_EXTERN ficlStack *stackCreate   (unsigned cells) { return ficlStackCreate(NULL, "unknown", cells); }
+FICL_PLATFORM_EXTERN void        stackDelete   (ficlStack *stack) { ficlStackDestroy(stack); }
+FICL_PLATFORM_EXTERN int         stackDepth    (ficlStack *stack) { return ficlStackDepth(stack); }
+FICL_PLATFORM_EXTERN void        stackDrop     (ficlStack *stack, int n) { ficlStackDrop(stack, n); }
+FICL_PLATFORM_EXTERN ficlCell    stackFetch    (ficlStack *stack, int n) { return ficlStackFetch(stack, n); }
+FICL_PLATFORM_EXTERN ficlCell    stackGetTop   (ficlStack *stack) { return ficlStackFetch(stack, 0); }
+#if FICL_WANT_LOCALS
+FICL_PLATFORM_EXTERN void        stackLink     (ficlStack *stack, int cells) { ficlStackLink(stack, cells); }
+FICL_PLATFORM_EXTERN void        stackUnlink   (ficlStack *stack) { ficlStackUnlink(stack); }
+#endif /* FICL_WANT_LOCALS */
+FICL_PLATFORM_EXTERN void        stackPick     (ficlStack *stack, int n) { ficlStackPick(stack, n); }
+FICL_PLATFORM_EXTERN ficlCell    stackPop      (ficlStack *stack) { return ficlStackPop(stack); }
+FICL_PLATFORM_EXTERN void       *stackPopPtr   (ficlStack *stack) { return ficlStackPopPointer(stack); }
+FICL_PLATFORM_EXTERN ficlUnsigned stackPopUNS   (ficlStack *stack) { return ficlStackPopUnsigned(stack); }
+FICL_PLATFORM_EXTERN ficlInteger stackPopINT   (ficlStack *stack) { return ficlStackPopInteger(stack); }
+FICL_PLATFORM_EXTERN void        stackPush     (ficlStack *stack, ficlCell cell) { ficlStackPush(stack, cell); }
+FICL_PLATFORM_EXTERN void        stackPushPtr  (ficlStack *stack, void *pointer) { ficlStackPushPointer(stack, pointer); }
+FICL_PLATFORM_EXTERN void        stackPushUNS  (ficlStack *stack, ficlUnsigned u) { ficlStackPushUnsigned(stack, u); }
+FICL_PLATFORM_EXTERN void        stackPushINT  (ficlStack *stack, ficlInteger i) { ficlStackPushInteger(stack, i); }
+FICL_PLATFORM_EXTERN void        stackReset    (ficlStack *stack) { ficlStackReset(stack); }
+FICL_PLATFORM_EXTERN void        stackRoll     (ficlStack *stack, int n) { ficlStackRoll(stack, n); }
+FICL_PLATFORM_EXTERN void        stackSetTop   (ficlStack *stack, ficlCell cell) { ficlStackSetTop(stack, cell); }
+FICL_PLATFORM_EXTERN void        stackStore    (ficlStack *stack, int n, ficlCell cell) { ficlStackStore(stack, n, cell); }
+
+#if (FICL_WANT_FLOAT)
+FICL_PLATFORM_EXTERN ficlFloat   stackPopFloat (ficlStack *stack) { return ficlStackPopFloat(stack); }
+FICL_PLATFORM_EXTERN void        stackPushFloat(ficlStack *stack, ficlFloat f) { ficlStackPushFloat(stack, f); }
+#endif
+
+FICL_PLATFORM_EXTERN int wordIsImmediate(ficlWord *word) { return ficlWordIsImmediate(word); }
+FICL_PLATFORM_EXTERN int wordIsCompileOnly(ficlWord *word) { return ficlWordIsCompileOnly(word); }
+
+
+FICL_PLATFORM_EXTERN void        vmBranchRelative(ficlVm *vm, int offset) { ficlVmBranchRelative(vm, offset); }
+FICL_PLATFORM_EXTERN ficlVm     *vmCreate       (ficlVm *vm, unsigned nPStack, unsigned nRStack) { return ficlVmCreate(vm, nPStack, nRStack); }
+FICL_PLATFORM_EXTERN void        vmDelete       (ficlVm *vm) { ficlVmDestroy(vm); }
+FICL_PLATFORM_EXTERN void        vmExecute      (ficlVm *vm, ficlWord *word) { ficlVmExecuteWord(vm, word); }
+FICL_PLATFORM_EXTERN ficlDictionary *vmGetDict  (ficlVm *vm) { return ficlVmGetDictionary(vm); }
+FICL_PLATFORM_EXTERN char *      vmGetString    (ficlVm *vm, ficlCountedString *spDest, char delimiter) { return ficlVmGetString(vm, spDest, delimiter); }
+FICL_PLATFORM_EXTERN ficlString  vmGetWord      (ficlVm *vm) { return ficlVmGetWord(vm); }
+FICL_PLATFORM_EXTERN ficlString  vmGetWord0     (ficlVm *vm) { return ficlVmGetWord0(vm); }
+FICL_PLATFORM_EXTERN int         vmGetWordToPad (ficlVm *vm) { return ficlVmGetWordToPad(vm); }
+FICL_PLATFORM_EXTERN ficlString  vmParseString  (ficlVm *vm, char delimiter) { return ficlVmParseString(vm, delimiter); }
+FICL_PLATFORM_EXTERN ficlString  vmParseStringEx(ficlVm *vm, char delimiter, char skipLeading) { return ficlVmParseStringEx(vm, delimiter, skipLeading); }
+FICL_PLATFORM_EXTERN ficlCell    vmPop          (ficlVm *vm) { return ficlVmPop(vm); }
+FICL_PLATFORM_EXTERN void        vmPush         (ficlVm *vm, ficlCell cell) { ficlVmPush(vm, cell); }
+FICL_PLATFORM_EXTERN void        vmPopIP        (ficlVm *vm) { ficlVmPopIP(vm); }
+FICL_PLATFORM_EXTERN void        vmPushIP       (ficlVm *vm, ficlIp newIP) { ficlVmPushIP(vm, newIP); }
+FICL_PLATFORM_EXTERN void        vmQuit         (ficlVm *vm) { ficlVmQuit(vm); }
+FICL_PLATFORM_EXTERN void        vmReset        (ficlVm *vm) { ficlVmReset(vm); }
+FICL_PLATFORM_EXTERN void        vmThrow        (ficlVm *vm, int except) { ficlVmThrow(vm, except); }
+FICL_PLATFORM_EXTERN void        vmThrowErr     (ficlVm *vm, char *fmt, ...) { va_list list; va_start(list, fmt); ficlVmThrowErrorVararg(vm, fmt, list); va_end(list); }
+
+FICL_PLATFORM_EXTERN void        vmCheckStack(ficlVm *vm, int popCells, int pushCells) { FICL_IGNORE(vm); FICL_IGNORE(popCells); FICL_IGNORE(pushCells); FICL_STACK_CHECK(vm->dataStack, popCells, pushCells); }
+#if FICL_WANT_FLOAT
+FICL_PLATFORM_EXTERN void        vmCheckFStack(ficlVm *vm, int popCells, int pushCells) { FICL_IGNORE(vm); FICL_IGNORE(popCells); FICL_IGNORE(pushCells); FICL_STACK_CHECK(vm->floatStack, popCells, pushCells); }
+#endif
+
+FICL_PLATFORM_EXTERN void        vmPushTib  (ficlVm *vm, char *text, ficlInteger nChars, ficlTIB *pSaveTib) { ficlVmPushTib(vm, text, nChars, pSaveTib); }
+FICL_PLATFORM_EXTERN void        vmPopTib   (ficlVm *vm, ficlTIB *pTib) { ficlVmPopTib(vm, pTib); }
+
+FICL_PLATFORM_EXTERN int        isPowerOfTwo(ficlUnsigned u) { return ficlIsPowerOfTwo(u); }
+
+#if defined(_WIN32)
+/* #SHEESH
+** Why do Microsoft Meatballs insist on contaminating
+** my namespace with their string functions???
+*/
+#pragma warning(disable: 4273)
+#endif
+char       *ltoa(ficlInteger value, char *string, int radix ) { return ficlLtoa(value, string, radix); }
+char       *ultoa(ficlUnsigned value, char *string, int radix ) { return ficlUltoa(value, string, radix); }
+char       *strrev( char *string ) { return ficlStringReverse(string); }
+#if defined(_WIN32)
+#pragma warning(default: 4273)
+#endif
+FICL_PLATFORM_EXTERN char        digit_to_char(int value) { return ficlDigitToCharacter(value); }
+FICL_PLATFORM_EXTERN char       *skipSpace(char *cp, char *end) { return ficlStringSkipSpace(cp, end); }
+FICL_PLATFORM_EXTERN char       *caseFold(char *cp) { return ficlStringCaseFold(cp); }
+FICL_PLATFORM_EXTERN int         strincmp(char *cp1, char *cp2, ficlUnsigned count) { return ficlStrincmp(cp1, cp2, count); }
+
+FICL_PLATFORM_EXTERN void        hashForget    (ficlHash *hash, void *where) { ficlHashForget(hash, where); }
+FICL_PLATFORM_EXTERN ficlUnsigned16 hashHashCode  (ficlString string) { return ficlHashCode(string); }
+FICL_PLATFORM_EXTERN void        hashInsertWord(ficlHash *hash, ficlWord *word) { ficlHashInsertWord(hash, word); }
+FICL_PLATFORM_EXTERN ficlWord   *hashLookup    (ficlHash *hash, ficlString string, ficlUnsigned16 hashCode) { return ficlHashLookup(hash, string, hashCode); }
+FICL_PLATFORM_EXTERN void        hashReset     (ficlHash *hash) { ficlHashReset(hash); }
+
+
+FICL_PLATFORM_EXTERN void       *alignPtr(void *ptr) { return ficlAlignPointer(ptr); }
+FICL_PLATFORM_EXTERN void        dictAbortDefinition(ficlDictionary *dictionary) { ficlDictionaryAbortDefinition(dictionary); }
+FICL_PLATFORM_EXTERN void        dictAlign      (ficlDictionary *dictionary) { ficlDictionaryAlign(dictionary); }
+FICL_PLATFORM_EXTERN int         dictAllot      (ficlDictionary *dictionary, int n) { ficlDictionaryAllot(dictionary, n); return 0; }
+FICL_PLATFORM_EXTERN int         dictAllotCells (ficlDictionary *dictionary, int cells) { ficlDictionaryAllotCells(dictionary, cells); return 0; }
+FICL_PLATFORM_EXTERN void        dictAppendCell (ficlDictionary *dictionary, ficlCell cell) { ficlDictionaryAppendCell(dictionary, cell); }
+FICL_PLATFORM_EXTERN void        dictAppendChar (ficlDictionary *dictionary, char c) { ficlDictionaryAppendCharacter(dictionary, c); }
+FICL_PLATFORM_EXTERN ficlWord   *dictAppendWord (ficlDictionary *dictionary, 
+                           char *name,
+                           ficlPrimitive code,
+                           ficlUnsigned8 flags)
+							{ return ficlDictionaryAppendPrimitive(dictionary, name, code, flags); }
+FICL_PLATFORM_EXTERN ficlWord   *dictAppendWord2(ficlDictionary *dictionary, 
+                           ficlString name,
+                           ficlPrimitive code,
+                           ficlUnsigned8 flags)
+						   { return ficlDictionaryAppendWord(dictionary, name, code, flags); }
+FICL_PLATFORM_EXTERN void        dictAppendUNS  (ficlDictionary *dictionary, ficlUnsigned u) { ficlDictionaryAppendUnsigned(dictionary, u); }
+FICL_PLATFORM_EXTERN int         dictCellsAvail (ficlDictionary *dictionary) { return ficlDictionaryCellsAvailable(dictionary); }
+FICL_PLATFORM_EXTERN int         dictCellsUsed  (ficlDictionary *dictionary) { return ficlDictionaryCellsUsed(dictionary); }
+FICL_PLATFORM_EXTERN void        dictCheck      (ficlDictionary *dictionary, ficlVm *vm, int n) { FICL_IGNORE(dictionary); FICL_IGNORE(vm); FICL_IGNORE(n); FICL_VM_DICTIONARY_CHECK(vm, dictionary, n); }
+FICL_PLATFORM_EXTERN ficlDictionary  *dictCreate(unsigned cells) { return ficlDictionaryCreate(NULL, cells); }
+FICL_PLATFORM_EXTERN ficlDictionary  *dictCreateHashed(unsigned cells, unsigned hash) { return ficlDictionaryCreateHashed(NULL, cells, hash); }
+FICL_PLATFORM_EXTERN ficlHash  *dictCreateWordlist(ficlDictionary *dictionary, int nBuckets) { return ficlDictionaryCreateWordlist(dictionary, nBuckets); }
+FICL_PLATFORM_EXTERN void        dictDelete     (ficlDictionary *dictionary) { ficlDictionaryDestroy(dictionary); }
+FICL_PLATFORM_EXTERN void        dictEmpty      (ficlDictionary *dictionary, unsigned nHash) { ficlDictionaryEmpty(dictionary, nHash); }
+#if FICL_WANT_FLOAT
+FICL_PLATFORM_EXTERN  void ficlPrimitiveHashSummary(ficlVm *vm);
+FICL_PLATFORM_EXTERN void        dictHashSummary(ficlVm *vm) { ficlPrimitiveHashSummary(vm); }
+#endif
+FICL_PLATFORM_EXTERN int         dictIncludes   (ficlDictionary *dictionary, void *p) { return ficlDictionaryIncludes(dictionary, p); }
+FICL_PLATFORM_EXTERN ficlWord  *dictLookup     (ficlDictionary *dictionary, ficlString name) { return ficlDictionaryLookup(dictionary, name); }
+#if FICL_WANT_LOCALS
+FICL_PLATFORM_EXTERN ficlWord  *ficlLookupLoc  (ficlSystem *system, ficlString name) { return ficlDictionaryLookup(ficlSystemGetLocals(system), name); }
+#endif
+FICL_PLATFORM_EXTERN void        dictResetSearchOrder(ficlDictionary *dictionary) { ficlDictionaryResetSearchOrder(dictionary); }
+FICL_PLATFORM_EXTERN void        dictSetFlags   (ficlDictionary *dictionary, ficlUnsigned8 set, ficlUnsigned8 clear) { ficlDictionarySetFlags(dictionary, set); ficlDictionaryClearFlags(dictionary, clear); }
+FICL_PLATFORM_EXTERN void        dictSetImmediate(ficlDictionary *dictionary) { ficlDictionarySetImmediate(dictionary); }
+FICL_PLATFORM_EXTERN void        dictUnsmudge   (ficlDictionary *dictionary) { ficlDictionaryUnsmudge(dictionary); }
+FICL_PLATFORM_EXTERN ficlCell   *dictWhere      (ficlDictionary *dictionary) { return ficlDictionaryWhere(dictionary); }
+
+FICL_PLATFORM_EXTERN int  ficlAddParseStep(ficlSystem *system, ficlWord *word) { return ficlSystemAddParseStep(system, word); }
+FICL_PLATFORM_EXTERN void ficlAddPrecompiledParseStep(ficlSystem *system, char *name, ficlParseStep pStep) { ficlSystemAddPrimitiveParseStep(system, name, pStep); }
+FICL_PLATFORM_EXTERN void ficlPrimitiveParseStepList(ficlVm *vm);
+FICL_PLATFORM_EXTERN void ficlListParseSteps(ficlVm *vm) { ficlPrimitiveParseStepList(vm); }
+
+FICL_PLATFORM_EXTERN void       ficlTermSystem(ficlSystem *system) { ficlSystemDestroy(system); }
+FICL_PLATFORM_EXTERN int        ficlEvaluate(ficlVm *vm, char *pText) { return ficlVmEvaluate(vm, pText); }
+FICL_PLATFORM_EXTERN int        ficlExec (ficlVm *vm, char *pText) { ficlString s; FICL_STRING_SET_FROM_CSTRING(s, pText); return ficlVmExecuteString(vm, s); }
+FICL_PLATFORM_EXTERN int        ficlExecC(ficlVm *vm, char *pText, ficlInteger nChars) { ficlString s; FICL_STRING_SET_POINTER(s, pText); FICL_STRING_SET_LENGTH(s, nChars); return ficlVmExecuteString(vm, s); }
+FICL_PLATFORM_EXTERN int        ficlExecXT(ficlVm *vm, ficlWord *word) { return ficlVmExecuteXT(vm, word); }
+FICL_PLATFORM_EXTERN void ficlFreeVM(ficlVm *vm) { ficlVmDestroy(vm); }
+
+
+
+
+
+static void thunkTextOut(ficlCallback *callback, char *text)
+	{
+	ficlCompatibilityOutputFunction outputFunction;
+	if ((callback->vm != NULL) && (callback->vm->thunkedTextout != NULL))
+		outputFunction = callback->system->thunkedTextout;
+	else if (callback->system->thunkedTextout != NULL)
+		outputFunction = callback->system->thunkedTextout;
+	else
+		{
+		ficlCallbackDefaultTextOut(callback, text);
+		return;
+		}
+	ficlCompatibilityTextOutCallback(callback, text, outputFunction);
+	}
+
+
+FICL_PLATFORM_EXTERN void    vmSetTextOut(ficlVm *vm, ficlCompatibilityOutputFunction textOut)
+	{
+	vm->thunkedTextout = textOut;
+	ficlVmSetTextOut(vm, thunkTextOut);
+	}
+
+FICL_PLATFORM_EXTERN void        vmTextOut      (ficlVm *vm, char *text, int fNewline)
+	{
+	ficlVmTextOut(vm, text);
+	if (fNewline)
+		ficlVmTextOut(vm, "\n");
+	}
+
+
+FICL_PLATFORM_EXTERN void        ficlTextOut      (ficlVm *vm, char *text, int fNewline)
+	{
+	vmTextOut(vm, text, fNewline);
+	}
+
+extern ficlSystem *ficlSystemGlobal;
+static defaultStackSize = FICL_DEFAULT_STACK_SIZE;
+FICL_PLATFORM_EXTERN int ficlSetStackSize(int nStackCells)
+{
+	if (defaultStackSize < nStackCells)
+		defaultStackSize = nStackCells;
+	if ((ficlSystemGlobal != NULL) && (ficlSystemGlobal->stackSize < nStackCells))
+		ficlSystemGlobal->stackSize = nStackCells;
+	return defaultStackSize;
+}
+
+
+FICL_PLATFORM_EXTERN ficlSystem *ficlInitSystemEx(ficlSystemInformation *fsi)
+{
+	ficlSystem *returnValue;
+	ficlCompatibilityOutputFunction thunkedTextout;
+	ficlSystemInformation clone;
+
+	memcpy(&clone, fsi, sizeof(clone));
+	thunkedTextout = (ficlCompatibilityOutputFunction)clone.textOut;
+	clone.textOut = clone.errorOut = thunkTextOut;
+
+	returnValue = ficlSystemCreate(&clone);
+	if (returnValue != NULL)
+	{
+		returnValue->thunkedTextout = thunkedTextout;
+	}
+	return returnValue;
+}
+
+
+FICL_PLATFORM_EXTERN ficlSystem *ficlInitSystem(int nDictCells)
+{
+	ficlSystemInformation fsi;
+	ficlSystemInformationInitialize(&fsi);
+	fsi.dictionarySize = nDictCells;
+	if (fsi.stackSize < defaultStackSize)
+		fsi.stackSize = defaultStackSize;
+	return ficlSystemCreate(&fsi);
+}
+
+
+
+
+FICL_PLATFORM_EXTERN ficlVm    *ficlNewVM(ficlSystem *system)
+{
+	ficlVm *returnValue = ficlSystemCreateVm(system);
+	if (returnValue != NULL)
+	{
+		if ((returnValue->callback.textOut != NULL) && (returnValue->callback.textOut != thunkTextOut))
+		{
+			returnValue->thunkedTextout = (ficlCompatibilityOutputFunction)returnValue->callback.textOut;
+			returnValue->callback.textOut = thunkTextOut;
+		}
+		if ((returnValue->callback.errorOut != NULL) && (returnValue->callback.errorOut != thunkTextOut))
+		{
+			if (returnValue->thunkedTextout == NULL)
+				returnValue->thunkedTextout = (ficlCompatibilityOutputFunction)returnValue->callback.errorOut;
+			returnValue->callback.errorOut = thunkTextOut;
+		}
+	}
+	return returnValue;
+}
+
+
+
+FICL_PLATFORM_EXTERN ficlWord  *ficlLookup(ficlSystem *system, char *name) { return ficlSystemLookup(system, name); }
+FICL_PLATFORM_EXTERN ficlDictionary *ficlGetDict(ficlSystem *system) { return ficlSystemGetDictionary(system); }
+FICL_PLATFORM_EXTERN ficlDictionary *ficlGetEnv (ficlSystem *system) { return ficlSystemGetEnvironment(system); }
+FICL_PLATFORM_EXTERN void       ficlSetEnv (ficlSystem *system, char *name, ficlInteger value) { ficlDictionarySetConstant(ficlSystemGetDictionary(system), name, value); }
+FICL_PLATFORM_EXTERN void       ficlSetEnvD(ficlSystem *system, char *name, ficlInteger high, ficlInteger low) { ficl2Unsigned value; FICL_2UNSIGNED_SET(low, high, value);  ficlDictionarySet2Constant(ficlSystemGetDictionary(system), name, FICL_2UNSIGNED_TO_2INTEGER(value)); }
+#if FICL_WANT_LOCALS
+FICL_PLATFORM_EXTERN ficlDictionary *ficlGetLoc (ficlSystem *system) { return ficlSystemGetLocals(system); }
+#endif
+FICL_PLATFORM_EXTERN int        ficlBuild(ficlSystem *system, char *name, ficlPrimitive code, char flags) { ficlDictionary *dictionary = ficlSystemGetDictionary(system); ficlDictionaryLock(dictionary, FICL_TRUE); ficlDictionaryAppendPrimitive(dictionary, name, code, flags); ficlDictionaryLock(dictionary, FICL_FALSE); return 0; }
+FICL_PLATFORM_EXTERN void       ficlCompileCore(ficlSystem *system) { ficlSystemCompileCore(system); }
+FICL_PLATFORM_EXTERN void       ficlCompilePrefix(ficlSystem *system) { ficlSystemCompilePrefix(system); }
+FICL_PLATFORM_EXTERN void       ficlCompileSearch(ficlSystem *system) { ficlSystemCompileSearch(system); }
+FICL_PLATFORM_EXTERN void       ficlCompileSoftCore(ficlSystem *system) { ficlSystemCompileSoftCore(system); }
+FICL_PLATFORM_EXTERN void       ficlCompileTools(ficlSystem *system) { ficlSystemCompileTools(system); }
+FICL_PLATFORM_EXTERN void       ficlCompileFile(ficlSystem *system) { ficlSystemCompileFile(system); }
+#if FICL_WANT_FLOAT
+FICL_PLATFORM_EXTERN void       ficlCompileFloat(ficlSystem *system) { ficlSystemCompileFloat(system); }
+FICL_PLATFORM_EXTERN int        ficlParseFloatNumber( ficlVm *vm, ficlString string) { return ficlVmParseFloatNumber(vm, string); }
+#endif
+#if FICL_WANT_PLATFORM
+FICL_PLATFORM_EXTERN void       ficlCompilePlatform(ficlSystem *system) { ficlSystemCompilePlatform(system); }
+#endif
+FICL_PLATFORM_EXTERN int        ficlParsePrefix(ficlVm *vm, ficlString string) { return ficlVmParsePrefix(vm, string); }
+
+FICL_PLATFORM_EXTERN int        ficlParseNumber(ficlVm *vm, ficlString string) { return ficlVmParseNumber(vm, string); }
+FICL_PLATFORM_EXTERN void       ficlTick(ficlVm *vm) { ficlPrimitiveTick(vm); }
+FICL_PLATFORM_EXTERN void       parseStepParen(ficlVm *vm) { ficlPrimitiveParseStepParen(vm); }
+
+FICL_PLATFORM_EXTERN int        isAFiclWord(ficlDictionary *dictionary, ficlWord *word) { return ficlDictionaryIsAWord(dictionary, word); }
+
+
+FICL_PLATFORM_EXTERN void buildTestInterface(ficlSystem *system) { ficlSystemCompileExtras(system); }
+
+

Copied: soc2015/clord/head/sys/contrib/ficl/dictionary.c (from r287721, soc2015/clord/head/sys/contrib/ficl/dict.c)
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ soc2015/clord/head/sys/contrib/ficl/dictionary.c	Mon Jun 29 19:39:54 2015	(r287740, copy of r287721, soc2015/clord/head/sys/contrib/ficl/dict.c)
@@ -0,0 +1,864 @@
+/*******************************************************************
+** d i c t . c
+** Forth Inspired Command Language - dictionary methods
+** Author: John Sadler (john_sadler at alum.mit.edu)
+** Created: 19 July 1997
+** $Id: dict.c,v 1.14 2001/12/05 07:21:34 jsadler 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 at alum.mit.edu)
+** All rights reserved.
+**
+** Get the latest Ficl release at http://ficl.sourceforge.net
+**
+** I am interested in hearing from anyone who uses ficl. If you have
+** a problem, a success story, a defect, an enhancement request, or
+** if you would like to contribute to the ficl release, please
+** contact me by email at the address above.
+**
+** L I C E N S E  and  D I S C L A I M E R
+** 
+** Redistribution and use in source and binary forms, with or without
+** modification, are permitted provided that the following conditions
+** are met:
+** 1. Redistributions of source code must retain the above copyright
+**    notice, this list of conditions and the following disclaimer.
+** 2. Redistributions in binary form must reproduce the above copyright
+**    notice, this list of conditions and the following disclaimer in the
+**    documentation and/or other materials provided with the distribution.
+**
+** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+** ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+** SUCH DAMAGE.
+*/
+
+/* $FreeBSD$ */
+
+#ifdef TESTMAIN
+#include <stdio.h>
+#include <ctype.h>
+#else
+#include <stand.h>
+#endif
+#include <string.h>
+#include "ficl.h"
+
+/* Dictionary on-demand resizing control variables */
+CELL dictThreshold;
+CELL dictIncrease;
+
+
+static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si);
+
+/**************************************************************************
+                        d i c t A b o r t D e f i n i t i o n
+** Abort a definition in process: reclaim its memory and unlink it
+** from the dictionary list. Assumes that there is a smudged 
+** definition in process...otherwise does nothing.
+** NOTE: this function is not smart enough to unlink a word that
+** has been successfully defined (ie linked into a hash). It
+** only works for defs in process. If the def has been unsmudged,
+** nothing happens.
+**************************************************************************/
+void dictAbortDefinition(FICL_DICT *pDict)
+{
+    FICL_WORD *pFW;
+    ficlLockDictionary(TRUE);
+    pFW = pDict->smudge;
+
+    if (pFW->flags & FW_SMUDGE)
+        pDict->here = (CELL *)pFW->name;
+
+    ficlLockDictionary(FALSE);
+    return;
+}
+
+
+/**************************************************************************
+                        a l i g n P t r
+** Aligns the given pointer to FICL_ALIGN address units.
+** Returns the aligned pointer value.
+**************************************************************************/
+void *alignPtr(void *ptr)
+{
+#if FICL_ALIGN > 0
+    char *cp;
+    CELL c;
+    cp = (char *)ptr + FICL_ALIGN_ADD;
+    c.p = (void *)cp;
+    c.u = c.u & (~FICL_ALIGN_ADD);
+    ptr = (CELL *)c.p;
+#endif
+    return ptr;
+}
+
+
+/**************************************************************************
+                        d i c t A l i g n
+** Align the dictionary's free space pointer
+**************************************************************************/
+void dictAlign(FICL_DICT *pDict)
+{
+    pDict->here = alignPtr(pDict->here);
+}
+
+
+/**************************************************************************
+                        d i c t A l l o t
+** Allocate or remove n chars of dictionary space, with
+** checks for underrun and overrun
+**************************************************************************/
+int dictAllot(FICL_DICT *pDict, int n)
+{
+    char *cp = (char *)pDict->here;
+#if FICL_ROBUST
+    if (n > 0)
+    {
+        if ((unsigned)n <= dictCellsAvail(pDict) * sizeof (CELL))
+            cp += n;
+        else
+            return 1;       /* dict is full */
+    }
+    else
+    {
+        n = -n;
+        if ((unsigned)n <= dictCellsUsed(pDict) * sizeof (CELL))
+            cp -= n;
+        else                /* prevent underflow */
+            cp -= dictCellsUsed(pDict) * sizeof (CELL);
+    }
+#else
+    cp += n;
+#endif
+    pDict->here = PTRtoCELL cp;
+    return 0;
+}
+
+
+/**************************************************************************
+                        d i c t A l l o t C e l l s
+** Reserve space for the requested number of cells in the
+** dictionary. If nCells < 0 , removes space from the dictionary.
+**************************************************************************/
+int dictAllotCells(FICL_DICT *pDict, int nCells)
+{
+#if FICL_ROBUST
+    if (nCells > 0)
+    {
+        if (nCells <= dictCellsAvail(pDict))
+            pDict->here += nCells;
+        else
+            return 1;       /* dict is full */
+    }
+    else
+    {
+        nCells = -nCells;
+        if (nCells <= dictCellsUsed(pDict))
+            pDict->here -= nCells;
+        else                /* prevent underflow */
+            pDict->here -= dictCellsUsed(pDict);
+    }
+#else
+    pDict->here += nCells;
+#endif
+    return 0;
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d C e l l
+** Append the specified cell to the dictionary
+**************************************************************************/
+void dictAppendCell(FICL_DICT *pDict, CELL c)
+{
+    *pDict->here++ = c;
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d C h a r
+** Append the specified char to the dictionary
+**************************************************************************/
+void dictAppendChar(FICL_DICT *pDict, char c)
+{
+    char *cp = (char *)pDict->here;
+    *cp++ = c;
+    pDict->here = PTRtoCELL cp;
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d W o r d
+** Create a new word in the dictionary with the specified
+** name, code, and flags. Name must be NULL-terminated.
+**************************************************************************/
+FICL_WORD *dictAppendWord(FICL_DICT *pDict, 
+                          char *name, 
+                          FICL_CODE pCode, 
+                          UNS8 flags)
+{
+    STRINGINFO si;
+    SI_SETLEN(si, strlen(name));
+    SI_SETPTR(si, name);
+    return dictAppendWord2(pDict, si, pCode, flags);
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d W o r d 2
+** Create a new word in the dictionary with the specified
+** STRINGINFO, code, and flags. Does not require a NULL-terminated
+** name.
+**************************************************************************/
+FICL_WORD *dictAppendWord2(FICL_DICT *pDict, 
+                           STRINGINFO si, 
+                           FICL_CODE pCode, 
+                           UNS8 flags)
+{
+    FICL_COUNT len  = (FICL_COUNT)SI_COUNT(si);
+    char *pName;
+    FICL_WORD *pFW;
+
+    ficlLockDictionary(TRUE);
+
+    /*
+    ** NOTE: dictCopyName advances "here" as a side-effect.
+    ** It must execute before pFW is initialized.
+    */
+    pName         = dictCopyName(pDict, si);
+    pFW           = (FICL_WORD *)pDict->here;
+    pDict->smudge = pFW;
+    pFW->hash     = hashHashCode(si);
+    pFW->code     = pCode;
+    pFW->flags    = (UNS8)(flags | FW_SMUDGE);
+    pFW->nName    = (char)len;
+    pFW->name     = pName;
+    /*
+    ** Point "here" to first cell of new word's param area...
+    */
+    pDict->here   = pFW->param;
+
+    if (!(flags & FW_SMUDGE))
+        dictUnsmudge(pDict);
+
+    ficlLockDictionary(FALSE);
+    return pFW;
+}
+
+
+/**************************************************************************
+                        d i c t A p p e n d U N S
+** Append the specified FICL_UNS to the dictionary
+**************************************************************************/
+void dictAppendUNS(FICL_DICT *pDict, FICL_UNS u)
+{
+    *pDict->here++ = LVALUEtoCELL(u);
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t C e l l s A v a i l
+** Returns the number of empty cells left in the dictionary
+**************************************************************************/
+int dictCellsAvail(FICL_DICT *pDict)
+{
+    return pDict->size - dictCellsUsed(pDict);
+}
+
+
+/**************************************************************************
+                        d i c t C e l l s U s e d
+** Returns the number of cells consumed in the dicionary
+**************************************************************************/
+int dictCellsUsed(FICL_DICT *pDict)
+{
+    return pDict->here - pDict->dict;
+}
+
+
+/**************************************************************************
+                        d i c t C h e c k
+** Checks the dictionary for corruption and throws appropriate
+** errors.
+** Input: +n number of ADDRESS UNITS (not Cells) proposed to allot
+**        -n number of ADDRESS UNITS proposed to de-allot
+**         0 just do a consistency check
+**************************************************************************/
+void dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int n)
+{
+    if ((n >= 0) && (dictCellsAvail(pDict) * (int)sizeof(CELL) < n))
+    {
+        vmThrowErr(pVM, "Error: dictionary full");
+    }
+
+    if ((n <= 0) && (dictCellsUsed(pDict) * (int)sizeof(CELL) < -n))
+    {
+        vmThrowErr(pVM, "Error: dictionary underflow");
+    }
+
+    if (pDict->nLists > FICL_DEFAULT_VOCS)
+    {
+        dictResetSearchOrder(pDict);
+        vmThrowErr(pVM, "Error: search order overflow");
+    }
+    else if (pDict->nLists < 0)
+    {
+        dictResetSearchOrder(pDict);
+        vmThrowErr(pVM, "Error: search order underflow");
+    }
+
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t C o p y N a m e
+** Copy up to nFICLNAME characters of the name specified by si into
+** the dictionary starting at "here", then NULL-terminate the name,
+** point "here" to the next available byte, and return the address of
+** the beginning of the name. Used by dictAppendWord.
+** N O T E S :
+** 1. "here" is guaranteed to be aligned after this operation.
+** 2. If the string has zero length, align and return "here"
+**************************************************************************/
+static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si)
+{
+    char *oldCP    = (char *)pDict->here;
+    char *cp       = oldCP;
+    char *name     = SI_PTR(si);
+    int   i        = SI_COUNT(si);
+
+    if (i == 0)
+    {
+        dictAlign(pDict);
+        return (char *)pDict->here;
+    }
+
+    if (i > nFICLNAME)
+        i = nFICLNAME;
+    
+    for (; i > 0; --i)
+    {
+        *cp++ = *name++;
+    }
+
+    *cp++ = '\0';
+
+    pDict->here = PTRtoCELL cp;
+    dictAlign(pDict);
+    return oldCP;
+}
+
+
+/**************************************************************************
+                        d i c t C r e a t e
+** Create and initialize a dictionary with the specified number
+** of cells capacity, and no hashing (hash size == 1).
+**************************************************************************/
+FICL_DICT  *dictCreate(unsigned nCells)
+{
+    return dictCreateHashed(nCells, 1);
+}
+
+
+FICL_DICT  *dictCreateHashed(unsigned nCells, unsigned nHash)
+{
+    FICL_DICT *pDict;
+    size_t nAlloc;
+
+    nAlloc =  sizeof (FICL_HASH) + nCells      * sizeof (CELL)
+                                 + (nHash - 1) * sizeof (FICL_WORD *);
+
+    pDict = ficlMalloc(sizeof (FICL_DICT));
+    assert(pDict);
+    memset(pDict, 0, sizeof (FICL_DICT));
+    pDict->dict = ficlMalloc(nAlloc);
+    assert(pDict->dict);
+
+    pDict->size = nCells;
+    dictEmpty(pDict, nHash);
+    return pDict;
+}
+
+
+/**************************************************************************
+                        d i c t C r e a t e W o r d l i s t
+** Create and initialize an anonymous wordlist
+**************************************************************************/
+FICL_HASH *dictCreateWordlist(FICL_DICT *dp, int nBuckets)
+{
+    FICL_HASH *pHash;
+    
+    dictAlign(dp);
+    pHash    = (FICL_HASH *)dp->here;
+    dictAllot(dp, sizeof (FICL_HASH) 
+        + (nBuckets-1) * sizeof (FICL_WORD *));
+
+    pHash->size = nBuckets;
+    hashReset(pHash);
+    return pHash;
+}
+
+
+/**************************************************************************
+                        d i c t D e l e t e 
+** Free all memory allocated for the given dictionary 
+**************************************************************************/
+void dictDelete(FICL_DICT *pDict)
+{
+    assert(pDict);
+    ficlFree(pDict);
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t E m p t y
+** Empty the dictionary, reset its hash table, and reset its search order.
+** Clears and (re-)creates the hash table with the size specified by nHash.
+**************************************************************************/
+void dictEmpty(FICL_DICT *pDict, unsigned nHash)
+{
+    FICL_HASH *pHash;
+
+    pDict->here = pDict->dict;
+
+    dictAlign(pDict);
+    pHash = (FICL_HASH *)pDict->here;
+    dictAllot(pDict, 
+              sizeof (FICL_HASH) + (nHash - 1) * sizeof (FICL_WORD *));
+
+    pHash->size = nHash;
+    hashReset(pHash);
+
+    pDict->pForthWords = pHash;
+    pDict->smudge = NULL;
+    dictResetSearchOrder(pDict);
+    return;
+}
+
+
+/**************************************************************************
+                        d i c t H a s h S u m m a r y
+** Calculate a figure of merit for the dictionary hash table based
+** on the average search depth for all the words in the dictionary,
+** assuming uniform distribution of target keys. The figure of merit
+** is the ratio of the total search depth for all keys in the table
+** versus a theoretical optimum that would be achieved if the keys
+** were distributed into the table as evenly as possible. 
+** The figure would be worse if the hash table used an open
+** addressing scheme (i.e. collisions resolved by searching the
+** table for an empty slot) for a given size table.
+**************************************************************************/
+#if FICL_WANT_FLOAT
+void dictHashSummary(FICL_VM *pVM)
+{

*** DIFF OUTPUT TRUNCATED AT 1000 LINES ***


More information about the svn-soc-all mailing list