ref: 67757267d0b9c6b15a0f9a87abab74ab152d9b09
author: grobe0ba <[email protected]>
date: Tue Aug 2 09:09:00 EDT 2022
initial commit
--- /dev/null
+++ b/Makefile
@@ -1,0 +1,89 @@
+SRCDIR= .
+VPATH= ${SRCDIR}:${SRCDIR}/softcore+# core:
+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 utility.o hash.o callback.o word.o extras.o $(OBJECTS.$(platform))
+HEADERS= ficl.h $(HEADERS.$(platform))
+# platform dependent source:
+OBJECTS.unix= unix.o
+HEADERS.unix= ficlplatform/unix.h
+OBJECTS.ansi= ansi.o
+HEADERS.ansi= ficlplatform/ansi.h
+# soft core:
+SOURCES = softcore.fr ifbrack.fr prefix.fr ficl.fr jhlocal.fr marker.fr oo.fr classes.fr string.fr ficllocal.fr fileaccess.fr
+#
+# Flags for shared library
+SHFLAGS = -fPIC
+CFLAGS= $(CFLAGS.$(platform)) -O ${SHFLAGS} -Wall+CPPFLAGS= $(CPPFLAGS.$(platform)) -I.
+# Platform dependent flags:
+CFLAGS.unix= # empty
+CPPFLAGS.unix= # empty
+CFLAGS.ansi= -ansi
+CPPFLAGS.ansi= -ansi -DFICL_ANSI
+# Default platform is "unix"
+platform= unix
+#
+CC = pcc
+LIB = ar cr
+RANLIB = echo
+
+MAJOR = 4
+MINOR = 1.0
+
+.PHONY: all test clean
+.PHONY: lib
+
+all: ficl
+
+test:
+ wd="$$(pwd)"; cd test && "$${wd}"/ficl ficltest.fr < /dev/null+
+ficl: main.o ${HEADERS} libficl.a+ ${CC} ${CFLAGS} ${LDFLAGS} -o $@ main.o -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,$@ -o $@ ${OBJECTS}+ ln -sf libficl.so.${MAJOR}.${MINOR} libficl.so+
+main: main.o ficl.h sysdep.h libficl.so.${MAJOR}.${MINOR}+ ${CC} ${CFLAGS} ${LDFLAGS} -o $@ main.o -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 $@ $<+
+# generate softcore source
+softcore.c: ${SOURCES}+ (cd softcore && exec ${MAKE} softcore.c) && cp softcore/softcore.c .+
+#
+# generic object code
+#
+.SUFFIXES: .cxx .cc .c .o
+
+.c.o:
+ ${CC} ${CFLAGS} ${CPPFLAGS} -c -o $@ $<+
+.cxx.o:
+ ${CXX} ${CXXFLAGS} ${CPPFLAGS} -c -o $@ $<+
+.cc.o:
+ ${CXX} ${CXXFLAGS} ${CPPFLAGS} -c -o $@ $<+#
+# generic cleanup code
+#
+clean:
+ rm -f *.o *.a *.core libficl.* ficl
+ rm -f softcore.c softcore/softcore.c softcore/makesoftcore
--- /dev/null
+++ b/ReadMe.txt
@@ -1,0 +1,51 @@
+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, Linux: use "Makefile".
+ * 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.
+
--- /dev/null
+++ b/bit.c
@@ -1,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]);
+}
--- /dev/null
+++ b/callback.c
@@ -1,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;
+}
+
+
--- /dev/null
+++ b/compatibility.c
@@ -1,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); }+
+
--- /dev/null
+++ b/contrib/xclasses/readme.txt
@@ -1,0 +1,111 @@
+XClasses is a simple IDL written in Python.
+You declare your classes, methods, and members as Python objects,
+and XClasses will generate the .c, .h, and .f files for you.
+Not only do the Forth classes line up with their C counterparts
+exactly, but all non-static methods (virtual and non-virtual)
+are *automatically* thunked. In other words, any method
+declared in XClasses and implemented in C can be called from
+the matching Ficl class, and the C method will be automatically
+called with the correct arguments. XClasses handles floating-point
+arguments too!
+
+Known limitations:
+ * All arguments must be one cell wide. (That means
+ only single-precision floats, too.)
+
+
+
+To use:
+ * Declare all your classes in a .py script
+ * Include "xclasses.h" everywhere you need your classes
+ * Include xclasses.cpp in your project somewhere
+ * Call
+ "xclasses.f" included
+ from your Ficl initialization script
+
+And you're mostly done!
+
+Simply including xclasses.f is not enough, though. You must
+explicitly instantiate your classes. This is to allow you a
+chance to add your own methods to the class. For a class
+named "myCallback", it would look like this:
+
+ declare-myCallback
+ end-myCallback
+
+You also have to define the "init" function for the class.
+Most of the time this will work fine:
+
+ declare-myCallback
+ use-default-init
+ end-myCallback
+
+
+The "default" init function calls the super class's init
+function, then sets all data members to 0. If this isn't
+what you want, roll your own. The init function takes
+the usual 2-cell "this" pointer as its argument:
+
+ declare-myCallback
+ : init ( 2:this ) ...
+ ;
+ end-myCallback
+
+For a do-nothing init function, you'll want this:
+
+ declare-myCallback
+ : init 2drop ;
+ end-myCallback
+
+
+Here's a random example from the simple game I'm working on:
+
+-----------------------------------------------------------------
+skinStream = xMethod("stream", "void").setVirtual(1)+gjeSkin.addMethod(skinStream)
+
+##
+## gjeTexture
+##
+##
+gjeTexture = xClass("gjeTexture")+gjeTexture.setParent(gjeSkin)
+gjeTexture.addMethod(skinStream)
+gjeTexture.addMethod(xMethod("clear", "void"))+gjeTexture.addMember(xVariable("texture", "LPDIRECT3DTEXTURE8"))+gjeTexture.addMember(xVariable("name", "char *"))+gjeTexture.addMember(xVariable("variation", "int"))+gjeTexture.addMember(xVariable("material", "D3DMATERIAL8 *"))+
+-----------------------------------------------------------------
+
+I sure hope that's enough to get you started.
+
+
+
+Random notes:
+* XClasses doesn't deal well with struct-packing issues. It assumes
+ pretty much everything will be 4-byte aligned. This can bite you
+ if you add a 64-bit int... the C compiler may align it for you,
+ and XClasses won't know about it. (This could be fixed in a future
+ release... are you volunteering?) For now, it's best to declare
+ your classes such that 64-bit ints are naturally 8-byte aligned.
+
+* If you don't want to have to declare each class in turn,
+ you can add something like this to the end of your Python script:
+-----
+def declare(name):
+ xAddFiclFooter("\t\"" + name + ".constant\" \" sfind swap drop 0= [if] declare-" + name + " use-default-init end-" + name + " [endif] \" evaluate")+
+
+xAddFiclFooter(": xclassesDeclare")+for c in classes:
+ declare(c.name)
+xAddFiclFooter("\t;")+-----
+ and then call "xclassesDeclare" from your Ficl script just after
+ including "xclasses.f".
+
+
+--lch
[email protected]
--- /dev/null
+++ b/contrib/xclasses/xclasses.py
@@ -1,0 +1,870 @@
+import copy
+import string
+import sys
+import time
+import types
+
+
+def capitalize(s):
+ return string.upper(s[0]) + s[1:]
+
+def fprint(f, s):
+ print >> f, s
+
+
+def fprintHeader(f, comment = "//"):
+ fprint(f, comment)
+ fprint(f, comment + " Generated by xclasses.py at " + time.strftime("%Y/%m/%d %H:%M:%S"))+ fprint(f, comment)
+ fprint(f, comment)
+ fprint(f, "")
+
+def fprintFooter(f, comment = "//"):
+ fprint(f, "")
+ fprint(f, "")
+ fprint(f, comment + " end of file")
+ fprint(f, "")
+
+multicallCallTypeFunction = 0
+multicallCallTypeMethod = 1
+multicallCallTypeVirtualMethod = 2
+
+multicallReturnTypeVoid = 0
+multicallReturnTypeInteger = 16
+multicallReturnTypeCstring = 32
+multicallReturnTypeFloat = 48
+
+multicallExplicitVtable = 512
+
+
+ficlVmName = "ficlVm"
+
+h_headers = []
+def xAddHHeader(line):
+ h_headers.append(line)
+
+h_footers = []
+def xAddHFooter(line):
+ h_footers.append(line)
+
+ficl_headers = []
+def xAddFiclHeader(line):
+ ficl_headers.append(line)
+
+ficl_footers = []
+def xAddFiclFooter(line):
+ ficl_footers.append(line)
+
+c_headers = []
+def xAddCHeader(line):
+ c_headers.append(line)
+
+c_footers = []
+def xAddCFooter(line):
+ c_footers.append(line)
+
+
+classes = []
+
+class xVariable:
+ def __init__(self, name, typeCPP = None, cells = None, count = None, defaultValue = None, cstring = None):
+ self.comments = []
+ self.setName(name)
+ self.setCells(cells)
+ self.setCount(count)
+ self.setDefaultValue(defaultValue)
+ self.setCString(cstring)
+ self.setTypeCPP(typeCPP)
+
+ def setName(self, name):
+ self.name = name
+ return self
+
+ def setTypeCPP(self, typeCPP):
+ self.typeCPP = typeCPP
+ if (typeCPP == "char *"):
+ self.setCString(1)
+ return self
+
+ def setCells(self, cells):
+ if cells == None:
+ self.cells = 1
+ else:
+ self.cells = cells
+ return self
+
+ def setCString(self, cstring):
+ self.cstring = cstring
+ return self
+
+ def isCString(self):
+ return self.cstring
+
+ def getTotalSize(self):
+ return self.cells * self.count
+
+ def setCount(self, count):
+ if type(count) != types.IntType:
+ count = 1
+ self.count = count
+ return self
+
+ def setDefaultValue(self, defaultValue):
+ if (defaultValue != None) and (type(defaultValue) != types.StringType):
+ defaultValue = str(defaultValue)
+ self.defaultValue = defaultValue
+ return self
+
+ def addComment(self, c):
+ self.comments.append(c)
+ return self
+
+ def isFloat(self):
+ return self.typeCPP == "float"
+
+ def stringCPP(self, wantDefaultValues=1):
+ if (type(self.typeCPP) != types.StringType):
+ sys.exit("didn't set a CPP type on variable " + self.name + "!")+ output = self.typeCPP
+ if (self.typeCPP[-1] != "*") and (self.typeCPP[-1] != "&"):
+ output += " "
+ output += self.name
+ if self.count > 1:
+ output += "[" + str(self.count) + "]"
+ if self.count == 0:
+ output += "[]"
+ if wantDefaultValues and (self.defaultValue != None):
+ output += " = " + self.defaultValue
+ return output
+
+ def printH(self, f):
+ if len(self.comments):
+ for comment in self.comments:
+ fprint(f, "\t" + "// " + comment)
+ fprint(f, "\t" + self.stringCPP() + ";")
+
+ def printF(self, f):
+ totalCells = self.count * self.cells
+ if (totalCells <= 1):
+ typeF = "cell:"
+ else:
+ typeF = str(totalCells) + " cells:"
+ if len(self.comments):
+ for comment in self.comments:
+ fprint(f, "\t" + "// " + comment)
+ fprint(f, "\t" + "S\" " + typeF + " ." + self.name + " \" evaluate")
+
+
+class xMethod:
+ def __init__(self, name, returnType = None, virtual = None, static = None, body = None):
+ self.arguments = []
+ self.comments = []
+
+ self.setName(name)
+ self.setReturnType(returnType)
+ self.setVirtual(virtual)
+ self.setStatic(static)
+ self.setBody(body)
+ self.setThunkVariable(None)
+ self.vtableOffset = 0
+
+ def copy():
+ clone = xMethod(self.name, self.returnType, self.virtual, self.static)
+ clone.arguments = self.arguments
+ clone.comments = self.comments
+
+ def setName(self, name):
+ self.name = name
+ return self
+
+ def setReturnType(self, returnType):
+ if returnType.__class__ == xVariable:
+ self.returnType = returnType
+ elif type(returnType) == types.StringType:
+ self.returnType = xVariable("ignored", returnType)+ else:
+ self.returnType = None
+ return self
+
+ def returnTypeIsVoid(self):
+ return(self.returnType == None) or (self.returnType.typeCPP == None) or (self.returnType.typeCPP == "") or (self.returnType.typeCPP == "void")
+
+ def setVirtual(self, virtual):
+ self.virtual = virtual
+ return self
+
+ def isVirtual(self):
+ return self.virtual > 0
+
+ def isPureVirtual(self):
+ return self.virtual > 1
+
+ def setStatic(self, static):
+ self.static = static
+ return self
+
+ def setThunkVariable(self, thunkVariable):
+ self.thunkVariable = thunkVariable
+ return self
+
+ def isStatic(self):
+ return self.static
+
+ # a constructor or a destructor
+ def isClassSpecial(self):
+ return (self.returnType == None) or (self.returnType.typeCPP == None) or (self.returnType.typeCPP == "")
+
+ def setBody(self, body):
+ self.body = body
+ return self
+
+ def addArgument(self, argument):
+ self.arguments.append(argument)
+ return self
+
+ def addComment(self, c):
+ self.comments.append(c)
+ return self
+
+ def prototype(self, isDefinition=None):
+ arguments = ""
+ for a in self.arguments:
+ if len(arguments):
+ arguments += ", "
+ arguments += a.stringCPP(not isDefinition)
+
+ if len(arguments) == 0:
+ arguments = "void"
+ className = ""
+ if (isDefinition):
+ className = self.memberOf.name + "::"
+ modifiers = ""
+ if self.virtual and (not isDefinition):
+ modifiers += "virtual "
+ if self.static and (not isDefinition):
+ modifiers += "static "
+ returnType = ""
+ name = self.name
+ if (name == "") or (name == "~"):
+ name += self.memberOf.name
+ if (self.returnType != None) and (len(self.returnType.typeCPP) > 0):
+ returnType = self.returnType.typeCPP + " "
+ return modifiers + returnType + className + name + "(" + arguments + ")"+
+ def printH(self, f):
+ pureVirtual = ""
+ if (self.virtual > 1):
+ pureVirtual = " = 0"
+ suffix = ";"
+ modifiers = ""
+ if self.body != None:
+ modifiers = "inline "
+ suffix = " " + self.body
+ fprint(f, "\t" + modifiers + self.prototype() + pureVirtual + suffix)
+
+ def printF(self, f):
+ if not self.isVirtual():
+ return
+
+ if len(self.comments):
+ for comment in self.comments:
+ fprint(f, "\t" + "// " + comment)
+
+ flags = multicallReturnTypeInteger
+ if self.returnTypeIsVoid():
+ flags = multicallReturnTypeVoid
+ elif (self.returnType.isCString()):
+ flags = multicallReturnTypeCString
+ elif (self.returnType.typeCPP == "float"):
+ flags = multicallReturnTypeFloat
+ flags |= multicallCallTypeVirtualMethod
+ # move floating-point arguments from float stack
+ floatArgumentsBitfield = 0
+ cstringArgumentsBitfield = 0
+ argumentNumber = 0
+ cstrings = 0
+ name = self.name
+ if (self.memberOf.pureVirtual):
+ vtable = ""
+ else:
+ vtable = " drop [ " + self.memberOf.name + "-vtable literal ] "
+ flags |= multicallExplicitVtable
+ if (name == "") or (name == "~"):
+ name += self.memberOf.name
+ for a in self.arguments:
+ if a.isFloat():
+ floatArgumentsBitfield |= (1 << argumentNumber)
+ elif a.isCString():
+ cstringArgumentsBitfield |= (1 << argumentNumber)
+ cstrings += 1
+ argumentNumber += 1
+ fprint(f, "\tS\" : " + name + vtable + str(len(self.arguments) + cstrings) + " " + str(floatArgumentsBitfield) + " " + str(cstringArgumentsBitfield) + " " + str(self.vtableOffset) + " " + str(flags) + " multicall ; \" evaluate ")
+
+ def printCPP(self, f):
+ if (self.thunkVariable != None):
+ if (self.returnType != None) and (self.returnType.isCString()):
+ sys.exit("Can't thunk char * return values, sorry.")+ fprint(f, "")
+ fprint(f, self.prototype(1))
+ fprint(f, "\t{")+ fprint(f, "\tif (" + self.thunkVariable.name + " == NULL)")+ if self.isClassSpecial() or self.returnTypeIsVoid():
+ fprint(f, "\t\treturn;")
+ elif (self.returnType.isFloat()):
+ fprint(f, "\t\treturn 0.0f;")
+ else:
+ fprint(f, "\t\treturn (" + self.returnType.typeCPP + ")0;")+ fprint(f, "")
+
+ ficlVmName = self.memberOf.getFiclVmName()
+
+ ## output stack-checking code! how cool is that? --lch
+ dataStackPush = 2 # why 2? we always push this and ficlClass.
+ dataStackPop = 0
+ floatStackPush = 0
+ floatStackPop = 0
+
+ for a in self.arguments:
+ if (a.isCString()):
+ dataStackPush = dataStackPush + 2
+ elif (a.isFloat()):
+ floatStackPush = floatStackPush + 1
+ else:
+ dataStackPush = dataStackPush + 1
+
+ if (not self.returnTypeIsVoid()):
+ if (self.returnType.isFloat()):
+ floatStackPop = 1
+ else:
+ dataStackPop = 1
+
+ if (dataStackPush or dataStackPop or floatStackPush or floatStackPop):
+ fprint(f, "#ifdef _DEBUG")
+ if (dataStackPush or dataStackPop):
+ fprint(f, "\tficlStackCheck(" + ficlVmName + "->dataStack, " + str(dataStackPush) + ", " + str(dataStackPop) + ");")+ if (floatStackPush or floatStackPop):
+ fprint(f, "\tficlStackCheck(" + ficlVmName + "->floatStack, " + str(floatStackPush) + ", " + str(floatStackPop) + ");")+ fprint(f, "#endif // _DEBUG")
+
+ reversedArguments = copy.copy(self.arguments)
+ reversedArguments.reverse()
+
+ for a in reversedArguments:
+ if (a.isCString()):
+ fprint(f, "\tficlStackPushPointer(" + ficlVmName + "->dataStack, " + a.name + ");")+ fprint(f, "\tficlStackPushInteger(" + ficlVmName + "->dataStack, strlen(" + a.name + "));")+ elif (a.isFloat()):
+ fprint(f, "\tficlStackPushFloat(" + ficlVmName + "->floatStack, " + a.name + ");")+ else:
+ fprint(f, "\tficlStackPushInteger(" + ficlVmName + "->dataStack, (int)" + a.name + ");")+ fprint(f, "\tficlStackPushPointer(" + ficlVmName + "->dataStack, this);")+ fprint(f, "\tficlStackPushPointer(" + ficlVmName + "->dataStack, ficlClass);")+ fprint(f, "\tficlVmExecuteXT(" + ficlVmName + ", " + self.thunkVariable.name + ");")+ if (not self.returnTypeIsVoid()):
+ if (self.returnType.isFloat()):
+ fprint(f, "\treturn ficlStackPopFloat(" + ficlVmName + "->floatStack);")+ else:
+ fprint(f, "\treturn (" + self.returnType.typeCPP + ")ficlStackPopInteger(" + ficlVmName + "->dataStack);")+ fprint(f, "\t}")
+ fprint(f, "")
+
+ # don't do virtual functions
+ if self.isVirtual() or self.isClassSpecial():
+ return
+
+ name = self.name
+ if (name == "") or (name == "~"):
+ name += self.memberOf.name
+
+ fprint(f, "// " + self.memberOf.name + "::" + name)
+ if len(self.comments):
+ fprint(f, "\t" + "//")
+ for comment in self.comments:
+ fprint(f, "\t" + "// " + comment)
+
+ arguments = ""
+ for a in self.arguments:
+ if len(arguments):
+ arguments += ", "
+ arguments += a.stringCPP()
+
+ if len(arguments) == 0:
+ arguments = "void"
+ classModifier = self.memberOf.name + "::"
+ calltype = "FICL_MULTICALL_CALLTYPE_METHOD"
+ if self.isStatic():
+ classModifier = ""
+ calltype = "FICL_MULTICALL_CALLTYPE_FUNCTION"
+ returnString = "FICL_MULTICALL_RETURNTYPE_INTEGER"
+ if self.returnTypeIsVoid():
+ returnString = "FICL_MULTICALL_RETURNTYPE_VOID"
+ elif (self.returnType.typeCPP == "float"):
+ returnString = "FICL_MULTICALL_RETURNTYPE_FLOAT"
+ elif (self.returnType.isCString()):
+ returnString = "FICL_MULTICALL_RETURNTYPE_CSTRING"
+
+ # set bits in argumentFlags
+ floatArgumentsBitfield = 0
+ cstringArgumentsBitfield = 0
+ argumentNumber = 0
+ cstrings = 0
+ for a in self.arguments:
+ if a.isFloat():
+ floatArgumentsBitfield |= (1 << argumentNumber)
+ elif a.isCString():
+ cstringArgumentsBitfield |= (1 << argumentNumber)
+ cstrings += 1
+ argumentNumber += 1
+
+ uniqueSuffix = "_" + self.memberOf.name + "_" + name
+ # constructor is blank!
+ if (self.name == ""):
+ uniqueSuffix = "_" + self.memberOf.name + "_constructor"
+ # destructor is just a squiggle!
+ elif (self.name == "~"):
+ uniqueSuffix = "_" + self.memberOf.name + "_destructor"
+ printingHash = {}+ printingHash["classname"] = "xMethod" + uniqueSuffix
+ printingHash["variablename"] = "instance" + uniqueSuffix
+ printingHash["address"] = self.returnType.typeCPP + " (" + classModifier + "*address)(" + arguments + ")"+ printingHash["function"] = self.memberOf.name + "::" + name
+ printingHash["methodname"] = name
+ printingHash["argumentCount"] = str(len(self.arguments) + cstrings)
+ printingHash["floatArgumentsBitfield"] = str(floatArgumentsBitfield)
+ printingHash["cstringArgumentsBitfield"] = str(cstringArgumentsBitfield)
+ printingHash["flags"] = calltype + " | " + returnString
+ fprint(f, """
+struct %(classname)s
+ {+ char *name;
+ int argumentCount;
+ int floatArgumentBitfield;
+ int cstringArgumentBitfield;
+ int flags;
+ %(address)s;
+ int zero;
+ };
+
+static %(classname)s %(variablename)s = { "%(methodname)s", %(argumentCount)s, %(floatArgumentsBitfield)s, %(cstringArgumentsBitfield)s, %(flags)s, %(function)s, 0 };+""" % printingHash)
+
+
+
+
+
+class xClass:
+ def __init__(self, name):
+ self.members = []
+ self.methods = []
+ self.verbatim = []
+ self.name = name
+ self.superclass = None
+ self.superclassName = None
+ self.containsVtable = 0
+ self.vtableEntries = 0
+ self.firstMember = None
+ self.memberCellsTotal = 0
+ self.thunkedSubclass = None
+ self.pureVirtual = 0
+ self.setFiclVmName(None)
+ classes.append(self)
+
+
+ def subclassOf(self, superclass):
+ if type(superclass) == types.StringType:
+ self.superclassName = superclass
+ else:
+ self.superclass = superclass
+ self.superclassName = superclass.name
+ if superclass.containsVtable:
+ self.containsVtable = 2
+ self.pureVirtual = superclass.pureVirtual
+ self.vtableEntries = superclass.vtableEntries
+ else:
+ self.containsVtable = 0
+ return self
+
+ def thunkedSubclassOf(self, superclass):
+ self.subclassOf(superclass)
+ self.addMember(xVariable("ficlClass", "void *"))+ for method in superclass.methods:
+ if not method.isClassSpecial() or method.isPureVirtual():
+ method = copy.deepcopy(method)
+ if method.isPureVirtual():
+ method.setVirtual(1)
+ self.addThunkedMethod(method)
+ self.constructor = xMethod("")+ self.addMethod(self.constructor)
+ self.thunkedSubclass = 1
+ return self
+
+ def forwardDeclare(self):
+ xAddHHeader("class " + self.name + ";")+
+
+ def addVerbatim(self, v):
+ self.verbatim.append(v)
+ return self
+
+ def addMember(self, variable):
+ self.members.append(variable)
+ self.memberCellsTotal += variable.getTotalSize()
+ if (self.firstMember == None):
+ self.firstMember = variable
+ return self
+
+ def removeMember(self, variable):
+ self.members.remove(variable)
+ self.memberCellsTotal -= variable.getTotalSize()
+ if (self.firstMember == variable):
+ self.firstMember = self.members[0]
+ return self
+
+ def addMemberArray(self, array):
+ map(self.addMember, copy.deepcopy(array))
+
+
+ def findPreviousInstanceOfVirtualMethod(self, name):
+ for method in self.methods:
+ if method.name == name:
+ return method
+ if (self.superclass != None) and (type(self.superclass) != types.StringType):
+ return self.superclass.findPreviousInstanceOfVirtualMethod(name)
+ return None
+
+ def setFiclVmName(self, name):
+ self.ficlVmName = name
+ return self
+
+ def getFiclVmName(self):
+ if self.ficlVmName != None:
+ return self.ficlVmName
+
+ global ficlVmName
+ return ficlVmName
+
+ def addMethod(self, method):
+ method.memberOf = self
+ if method.virtual:
+ previousInstance = self.findPreviousInstanceOfVirtualMethod(method.name)
+ if (previousInstance != None):
+ method.vtableOffset = previousInstance.vtableOffset
+ if previousInstance.isPureVirtual() and (not method.isPureVirtual()):
+ self.pureVirtual -= 1
+ else:
+ method.vtableOffset = self.vtableEntries
+ self.vtableEntries = self.vtableEntries + 1
+ if (not self.containsVtable):
+ self.containsVtable = 1
+ if method.isPureVirtual():
+ self.pureVirtual += 1
+ self.methods.append(method)
+ return self
+
+ def lookupMethod(self, methodName):
+ for m in self.methods:
+ if (m.name == methodName):
+ return m
+ return None
+
+ def removeMethod(self, method):
+ if (type(method) == types.StringType):
+ method = self.lookupMethod(method)
+ if method == None:
+ return None
+ method.memberOf = None
+ self.methods.remove(method)
+ if method.virtual:
+ previousInstance = self.findPreviousInstanceOfVirtualMethod(method.name)
+ if (previousInstance == None):
+ for m in self.methods:
+ if (m.vtableOffset >= method.vtableOffset):
+ m.vtableOffset = m.vtableOffset - 1
+ self.vtableEntries = self.vtableEntries - 1
+ if (self.vtableEntries == 0):
+ self.containsVtable = 0
+ if previousInstance.isPureVirtual() and (not method.isPureVirtual()):
+ self.pureVirtual += 1
+ else:
+ if method.isPureVirtual():
+ self.pureVirtual -= 1
+
+ if method.thunkVariable != None:
+ self.removeMember(method.thunkVariable)
+
+ return self
+
+ def addThunkedMethod(self, method):
+ method = copy.deepcopy(method)
+ self.addMethod(method)
+ name = capitalize(method.name)
+ if (method.isClassSpecial()):
+ if (name == ""):
+ name = "Constructor"
+ else:
+ name = "Destructor"
+ thunkVariable = xVariable("xt" + name, "ficlWord *")+ self.addMember(thunkVariable)
+ method.setThunkVariable(thunkVariable)
+ return self
+
+ def addNoopConstructor(self):
+ self.addVerbatim(self.name + "() { }")+ return self
+
+ def addConstructor(self, virtual = 0):
+ method = xMethod("")+ method.setVirtual(virtual)
+ self.addMethod(method)
+ return method
+
+ def addDestructor(self, virtual = 0):
+ method = xMethod("~")+ method.setVirtual(virtual)
+ self.addMethod(method)
+ return method
+
+ def addMemberWithAccessors(self, variable, writeBodiesToo = 1):
+ self.addMember(variable)
+ capitalizedName = capitalize(variable.name)
+
+ m = xMethod("set" + capitalizedName, "void").addArgument(variable)+ if writeBodiesToo:
+ m.setBody("\t{ this->" + variable.name + " = " + variable.name + "; }")+ self.addMethod(m)
+
+ m = xMethod("get" + capitalizedName, variable.typeCPP)+ if writeBodiesToo:
+ m.setBody("\t{ return this->" + variable.name + "; }")+ self.addMethod(m)
+
+ def addMethodArray(self, array):
+ map(self.addMethod, copy.deepcopy(array))
+
+ def addThunkedMethodArray(self, array):
+ map(self.addThunkedMethod, copy.deepcopy(array))
+
+ def printHforward(self, f):
+ fprint(f, "class " + self.name + ";")
+
+ def printH(self, f):
+ if (self.thunkedSubclass):
+ body = "\n\t\t{\n"+ for m in self.methods:
+ if m.thunkVariable != None:
+ body += "\t\t" + m.thunkVariable.name + " = NULL;\n"
+ body += "\t\t}\n"
+ self.constructor.setBody(body)
+ s = ""
+ if self.superclassName != None:
+ s = " : public " + self.superclassName
+ fprint(f, "class " + self.name + s)
+ fprint(f, "\t" + "{")+ fprint(f, "\t" + "public:")
+ fprint(f, "")
+ for member in self.members:
+ member.printH(f)
+ fprint(f, "")
+ for method in self.methods:
+ method.printH(f)
+ for v in self.verbatim:
+ fprint(f, "\t" + v + "\n")
+ fprint(f, "\t" + "};\n\n")
+
+ def printF(self, f):
+ s = self.superclassName
+ if s == None:
+ s = "object"
+
+ fprint(f, "")
+ fprint(f, "//")
+ fprint(f, "// " + self.name)
+ fprint(f, "//")
+ fprint(f, ": declare-" + self.name)
+ fprint(f, "\t" + "S\" " + s + " subclass " + self.name + " \" evaluate")
+ fprint(f, "")
+ if self.containsVtable == 1:
+ fprint(f, "\t" + "S\" cell: .vtable\" evaluate")
+ for member in self.members:
+ member.printF(f)
+ fprint(f, "")
+ if (self.firstMember == None):
+ fprint(f, "\t" + "S\" : default-init 2drop ; \" evaluate // no members!")
+ else:
+ storeFiclClass = ""
+ if (self.thunkedSubclass != None):
+ storeFiclClass = "this this my=> .ficlClass ! drop "
+ setVtable = ""
+ if self.containsVtable and (not self.pureVirtual):
+ setVtable = self.name + "-vtable this my=> .vtable ! "
+ fprint(f, "\t" + "S\" : default-init { 2:this -- } this my=> super my=> init this my=> ." + self.firstMember.name + " " + str(self.memberCellsTotal) + " cells 0 fill " + setVtable + storeFiclClass + "; \" evaluate")+ fprint(f, "\t// " + self.name + " methods:")
+ fprint(f, "\t" + self.name + "-declare-methods")
+ for method in self.methods:
+ method.printF(f)
+ fprint(f, "\t;")
+ fprint(f, "")
+ fprint(f, ": end-" + self.name)
+ fprint(f, "\t" + "S\" end-class \" evaluate")
+ fprint(f, "\t" + "S\" " + self.name + " 2constant " + self.name + ".constant \" evaluate")
+ fprint(f, "\t;")
+ fprint(f, "")
+
+ def printCPP(self, f):
+ fprint(f, "//")
+ fprint(f, "// " + self.name)
+ fprint(f, "//")
+ for method in self.methods:
+ method.printCPP(f)
+ fprint(f, "")
+ fprint(f, "// " + self.name + " final structure")
+ fprint(f, "static xMethod *" + self.name + "_methods[] =")
+ fprint(f, "\t" + "{")+ for method in self.methods:
+ if (method.isVirtual() or method.isClassSpecial()):
+ continue
+ fprint(f, "\t" + "(xMethod *)(&instance_" + self.name + "_" + method.name + "),")
+ fprint(f, "\t" + "NULL")
+ fprint(f, "\t" + "};")
+ if self.containsVtable and (not self.pureVirtual):
+ fprint(f, "")
+ fprint(f, "// " + self.name + " instance, so we can get the vtable")
+ fprint(f, "static " + self.name + " " + self.name + "_instance;" )
+ fprint(f, "")
+
+
+
+def xclassesFooter():
+ f = open("xclasses.h", "wt")+
+ fprintHeader(f)
+ fprint(f, "#ifndef __XCLASSES_H")
+ fprint(f, "#define __XCLASSES_H")
+ fprint(f, "")
+ fprint(f, "extern void xclassesDefineMethods(ficlVm *vm);")
+ fprint(f, "")
+ fprint(f, "enum xtype");
+ fprint(f, "\t{");+ fprint(f, "\txtypeInvalid = 0,");
+ for c in classes:
+ fprint(f, "\txtype_" + c.name + ",");
+ fprint(f, "\txtypeLast,");
+ fprint(f, "\t};");
+ fprint(f, "");
+ for line in h_headers:
+ fprint(f, line)
+ fprint(f, "")
+ fprint(f, "")
+ for c in classes:
+ c.printH(f)
+ for line in h_footers:
+ fprint(f, line)
+ fprint(f, "")
+ fprint(f, "#endif // __XCLASSES_H")
+ fprintFooter(f)
+ f.close()
+
+
+ f = open("xclasses.f", "wt")+ fprintHeader(f)
+ fprint(f, ": use-default-init S\" : init { 2:this } this my=> super my=> init this my=> default-init ; \" evaluate ;");+ for line in ficl_headers:
+ fprint(f, line)
+ fprint(f, "")
+ for c in classes:
+ c.printF(f)
+ for line in ficl_footers:
+ fprint(f, line)
+ fprint(f, "")
+ fprintFooter(f)
+ f.close()
+
+
+ f = open("xclasses.cpp", "wt")+ fprintHeader(f)
+
+ for line in c_headers:
+ fprint(f, line)
+ fprint(f, "")
+
+ fprint(f, "#include \"xclasses.h\"")
+ fprint(f, """
+
+struct xMethod
+ {+ char *name;
+ int argumentCount;
+ int floatArgumentBitfield;
+ int cstringArgumentBitfield;
+ int flags;
+ void *address;
+ int zero;
+ };
+
+struct xClass
+ {+ char *name;
+ xMethod **methods;
+ void **instance;
+ };
+
+""")
+
+ for c in classes:
+ c.printCPP(f)
+ fprint(f, """
+static xClass classes[] =
+ {+""")
+ for c in classes:
+ vtableVariable = "NULL"
+ if c.containsVtable and (not c.pureVirtual):
+ vtableVariable = "(void **)&" + c.name + "_instance"
+ fprint(f, "\t" + "{ \"" + c.name + "\", " + c.name + "_methods, " + vtableVariable + " },")+ fprint(f, """
+ { NULL, NULL }+ };
+
+void xclassesDefineMethods(ficlVm *vm)
+ {+ char buffer[1024];
+ xClass *c;
+ xMethod **m;
+
+ for (c = classes; c->name != NULL; c++)
+ {+ sprintf(buffer, " : %s-declare-methods ", c->name);
+ ficlVmEvaluate(vm, buffer);
+ for (m = c->methods; *m != NULL; m++)
+ {+ xMethod *method = *m;
+ /* why is this here? I dunno, but MSVC seems to be packing my struct. So if address is zero, the next dword has the address. --lch */
+ if (method->address == NULL)
+ method->address = (void *)method->zero;
+ sprintf(buffer, " S\\" : %s drop %d %d %d %d %d multicall ; \\" evaluate ",
+ method->name,
+ method->argumentCount,
+ method->floatArgumentBitfield,
+ method->cstringArgumentBitfield,
+ method->address,
+ method->flags
+ );
+ ficlVmEvaluate(vm, buffer);
+ }
+ ficlVmEvaluate(vm, " ; ");
+ if (c->instance != NULL)
+ {+ sprintf(buffer, "%s-vtable", c->name);
+ ficlDictionarySetConstantPointer(ficlVmGetDictionary(vm), buffer, *(c->instance));
+ }
+ }
+ }
+""")
+ for line in c_footers:
+ fprint(f, line)
+ fprint(f, "")
+ fprintFooter(f)
+ f.close()
+
+
+
--- /dev/null
+++ b/dictionary.c
@@ -1,0 +1,852 @@
+/*******************************************************************
+** d i c t . c
+** Forth Inspired Command Language - dictionary methods
+** Author: John Sadler ([email protected])
+** Created: 19 July 1997
+** $Id: dictionary.c,v 1.6 2010/12/02 22:14:12 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 ([email protected])
+** 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 <ctype.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#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);
+ return;
+}
+
+
+/**************************************************************************
+ d i c t A l i g n
+** Align the dictionary's free space pointer
+**************************************************************************/
+void ficlDictionaryAlign(ficlDictionary *dictionary)
+{+ dictionary->here = (ficlCell*)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;
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ 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)
+{+ *dictionary->here++ = FICL_LVALUE_TO_CELL(u);
+ return;
+}
+
+
+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 (char*)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);
+
+ if (word == NULL)
+ {+ word = ficlDictionaryAppendConstantInstruction(dictionary, name, instruction, value);
+ }
+ else
+ {+ word->code = (ficlPrimitive)instruction;
+ word->param[0] = FICL_LVALUE_TO_CELL(value);
+ }
+ 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 ((word != NULL) &&
+ ((((ficlInstruction)(uintptr_t)word->code) == ficlInstruction2ConstantParen)
+#if FICL_WANT_FLOAT
+ ||
+ (((ficlInstruction)(uintptr_t)word->code) == ficlInstructionF2ConstantParen)
+#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 = (ficlDictionary*)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);
+ 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 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);
+ return;
+}
+
+
+/**************************************************************************
+** 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)(uintptr_t)word) > ficlInstructionInvalid)
+ && (((ficlInstruction)(uintptr_t)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_TRUE);
+ 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, "%3td ", 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, c.i, 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, (ficlWord*)c.p) && (c.i >= ficlInstructionLast))
+ {+ ficlWord *word = (ficlWord *)c.p;
+ sprintf(trace, "%.*s ( %#jx literal )",
+ word->length, word->name, (uintmax_t)c.u);
+ }
+ else
+ sprintf(trace, "literal %jd (%#jx)", (intmax_t)c.i, (uintmax_t)c.u);
+ break;
+ case FICL_WORDKIND_2LITERAL:
+ c = *++cell;
+ c2 = *++cell;
+ sprintf(trace, "2literal %jd %jd (%#jx %#jx)", (intmax_t)c2.i, (intmax_t)c.i, (uintmax_t)c2.u, (uintmax_t)c.u);
+ break;
+#if FICL_WANT_FLOAT
+ case FICL_WORDKIND_FLITERAL:
+ c = *++cell;
+ sprintf(trace, "fliteral %f (%#jx)", c.f, (uintmax_t)c.u);
+ break;
+#endif /* FICL_WANT_FLOAT */
+ case FICL_WORDKIND_STRING_LITERAL:
+ {+ ficlCountedString *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 = (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 %td", cell + c.i - param0);
+ break;
+ case FICL_WORDKIND_BRANCH:
+ c = *++cell;
+ sprintf(trace, "branch %td", cell + c.i - param0);
+ break;
+
+ case FICL_WORDKIND_QDO:
+ c = *++cell;
+ sprintf(trace, "?do (leave %td)", (ficlCell *)c.p - param0);
+ break;
+ case FICL_WORDKIND_DO:
+ c = *++cell;
+ sprintf(trace, "do (leave %td)", (ficlCell *)c.p - param0);
+ break;
+ case FICL_WORDKIND_LOOP:
+ c = *++cell;
+ sprintf(trace, "loop (branch %td)", cell + c.i - param0);
+ break;
+ case FICL_WORDKIND_OF:
+ c = *++cell;
+ sprintf(trace, "of (branch %td)", cell + c.i - param0);
+ break;
+ case FICL_WORDKIND_PLOOP:
+ c = *++cell;
+ sprintf(trace, "+loop (branch %td)", 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 )", cell->i, 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;
+ return;
+}
+
+
+/**************************************************************************
+ d i c t S e t F l a g s
+** Changes the flags field of the most recently defined word:
+** Set all bits that are ones in the set parameter.
+**************************************************************************/
+void ficlDictionarySetFlags(ficlDictionary *dictionary, ficlUnsigned8 set)
+{+ FICL_DICTIONARY_ASSERT(dictionary, dictionary->smudge);
+ dictionary->smudge->flags |= set;
+ return;
+}
+
+
+/**************************************************************************
+ 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;
+ return;
+}
+
+
+/**************************************************************************
+ d i c t S e t I m m e d i a t e
+** Set the most recently defined word as IMMEDIATE
+**************************************************************************/
+void ficlDictionarySetImmediate(ficlDictionary *dictionary)
+{+ FICL_DICTIONARY_ASSERT(dictionary, dictionary->smudge);
+ dictionary->smudge->flags |= FICL_WORD_IMMEDIATE;
+ return;
+}
+
+
+/**************************************************************************
+ d i c t U n s m u d g e
+** Completes the definition of a word by linking it
+** into the main list
+**************************************************************************/
+void 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);
+ return;
+}
+
+
+/**************************************************************************
+ 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;
+}
+
+
--- /dev/null
+++ b/doc/api.html
@@ -1,0 +1,401 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>ficl api</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+ficl api
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='QuickFiclProgrammingConceptsOverview'>
+Quick Ficl Programming Concepts Overview
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+
+A Ficl <i>dictionary</i> is equivalent to the FORTH "dictionary"; it is where words are stored.
+A single dictionary has a single <code>HERE</code> pointer.
+<p>
+
+A Ficl <i>system information</i> structure is used to change default values used
+in initializing a Ficl <i>system</i>.
+<p>
+
+A Ficl <i>system</i> contains a single <i>dictionary</i>, and one or more <i>virtual machines</i>.
+<p>
+
+A Ficl <i>stack</i> is equivalent to a FORTH "stack". Ficl has three stacks:
+<ul>
+
+<li>
+The <i>data</i> stack, where integer arguments are stored.
+
+<li>
+The <i>return</i> stack, where locals and return addresses for subroutine returns are stored.
+
+<li>
+The <i>float</i> stack, where floating-point arguments are stored. (This stack
+is only enabled when <code>FICL_WANT_FLOAT</code> is nonzero.)
+</ul>
+
+<p>
+
+A Ficl <i>virtual machine</i> (or <i>vm</i>) represents a single running instance of the Ficl interpreter.
+All virtual machines in a single Ficl system see the same dictionary.
+<p>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='QuickFiclProgrammingTutorial'>
+Quick Ficl Programming Tutorial
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+Though Ficl's API offers a great deal of flexibility, most programs
+incorporating Ficl simply use it as follows:
+
+<ol>
+
+<li>
+Create a single <code>ficlSystem</code> using <code>ficlSystemCreate(NULL)</code>.
+
+<li>
+Add native functions as necessary with <code>ficlDictionarySetPrimitive()</code>.
+
+<li>
+Add constants as necessary with <code>ficlDictionarySetConstant()</code>.
+
+<li>
+Create one (or more) virtual machine(s) with <code>ficlSystemCreateVm()</code>.
+
+<li>
+Add one or more scripted functions with <code>ficlVmEvaluate()</code>.
+
+<li>
+Execute code in a Ficl virtual machine, usually with <code>ficlVmEvaluate()</code>,
+but perhaps with <code>ficlVmExecuteXT()</code>.
+
+<li>
+At shutdown, call <code>ficlSystemDestroy()</code> on the single Ficl system.
+
+</ol>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='FiclApplicationProgrammingInterface'>
+Ficl Application Programming Interface
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+The following is a partial listing of functions that interface your
+system or program to Ficl. For a complete listing, see <code>ficl.h</code>
+(which is heavily commented). For a simple example, see <code>main.c</code>.
+<p>
+
+Note that as of Ficl 4, the API is internally consistent.
+<i>Every</i> external entry point starts with the word
+<code>ficl</code>, and the word after that also corresponds
+with the first argument. For instance, a word that operates
+on a <code>ficlSystem *</code> will be called <code>ficlSystem<i>Something</i>()</code>.
+
+
+
+
+<dl>
+
+<p><dt>
+<code>void ficlSystemInformationInitialize(ficlSystemInformation *fsi)</code>
+<dd>
+
+
+
+Resets a <code>ficlSystemInformation</code> structure to all zeros.
+(Actually implemented as a macro.) Use this to initialize a <code>ficlSystemInformation</code>
+structure before initializing its members and passing it
+into <code>ficlSystemCreate()</code> (below).
+
+<p><dt>
+<code>ficlSystem *ficlSystemCreate(ficlSystemInformation *fsi)</code>
+<dd>
+
+
+
+Initializes Ficl's shared system data structures, and creates the
+dictionary allocating the specified number of cells from the heap
+(by a call to <code>ficlMalloc()</code>). If you pass in a <code>NULL</code>
+pointer, you will recieve a <code>ficlSystem</code> using the default
+sizes for the dictionary and stacks.
+
+
+<p><dt>
+<code>void ficlSystemDestroy(ficlSystem *system)</code>
+<dd>
+
+
+
+Reclaims memory allocated for the Ficl system including all
+dictionaries and all virtual machines created by
+<code>ficlSystemCreateVm()</code>. Note that this will <i>not</i>
+automatically free memory allocated by the FORTH memory allocation
+words (<code>ALLOCATE</code> and <code>RESIZE</code>).
+
+<p><dt>
+<code>ficlWord *ficlDictionarySetPrimitive(ficlDictionary *dictionary, char *name, ficlCode code, ficlUnsigned8 flags)</code>
+<dd>
+
+
+
+Adds a new word to the dictionary with the given
+name, code pointer, and flags. To add
+<p>
+
+The <code>flags</code> parameter is a bitfield. The valid
+flags are:<ul>
+
+<li>
+FICL_WORD_IMMEDIATE
+<li>
+FICL_WORD_COMPILE_ONLY
+<li>
+FICL_WORD_SMUDGED
+<li>
+FICL_WORD_OBJECT
+<li>
+FICL_WORD_INSTRUCTION
+
+</ul>
+
+For more information on these flags, see <code>ficl.h</code>.
+
+
+<p><dt>
+<code>ficlVm *ficlSystemCreateVm(ficlSystem *system)</code>
+<dd>
+
+
+
+Creates a new virtual machine in the specified system.
+
+
+<p><dt>
+<code>int ficlVmEvaluate(ficlVm *vm, char *text)</code>
+<dd>
+
+
+
+ the specified C string (zero-terminated) to the given
+virtual machine for evaluation. Returns various exception codes (VM_XXXX
+in ficl.h) to indicate the reason for returning. Normal exit
+condition is VM_OUTOFTEXT, indicating that the VM consumed the string
+successfully and is back for more. Calls to <code>ficlVmEvaluate()</code>
+can be nested, and
+the function itself is re-entrant, but note that a VM is
+static, so you have to take reasonable precautions (for example, use one
+VM per thread in a multithreaded system if you want multiple threads to
+be able to execute commands).
+
+
+<p><dt>
+<code>int ficlVmExecuteXT(ficlVm *vm, ficlWord *pFW)</code>
+<dd>
+
+
+
+Same as ficlExec, but takes a pointer to a ficlWord instead of a
+string. Executes the word and returns after it has finished. If
+executing the word results in an exception, this function will
+re-throw the same code if it is nested under another ficlExec family
+function, or return the exception code directly if not. This function
+is useful if you need to execute the same word repeatedly—you
+save the dictionary search and outer interpreter overhead.
+
+<p><dt>
+<code>void ficlFreeVM(ficlVm *vm)</code>
+<dd>
+
+
+
+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.
+
+<p><dt>
+<code>ficlVm *ficlNewVM(ficlSystem *system)</code>
+<dd>
+
+
+
+Create, initialize, and return a VM from the heap using
+ficlMalloc. Links the VM into the system VM list for later reclamation
+by ficlTermSystem.
+
+<p><dt>
+<code>ficlWord *ficlSystemLookup(ficlSystem *system, char *name)</code>
+<dd>
+
+
+
+Returns the address of the specified word in the main dictionary.
+If no such word is found, it returns <code>NULL</code>.
+The address is also a valid execution token, and can be used in a call to <code>ficlVmExecuteXT()</code>.
+
+<p><dt>
+<code>ficlDictionary *ficlSystemGetDictionary(ficlSystem *system)<br>ficlDictionary *ficlVmGetDictionary(ficlVm *system)</code>
+<dd>
+
+
+
+Returns a pointer to the main system dictionary.
+
+
+<p><dt>
+<code>ficlDictionary *ficlSystemGetEnvironment(ficlSystem *system)</code>
+<dd>
+
+
+
+Returns a pointer to the environment dictionary. This dictionary
+stores information that describes this implementation as required by the
+Standard.
+
+
+
+
+<p><dt>
+<code>ficlDictionary *ficlSystemGetLocals(ficlSystem *system)</code>
+<dd>
+
+
+
+Returns a pointer to the locals dictionary. This function is
+defined only if <code>FICL_WANT_LOCALS</code> is non-zero (see <code>ficl.h</code>).
+The locals dictionary is the symbol table for
+<a href="locals.html">local variables</a>.
+
+
+</dl>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='FiclCompile-TimeConstants'>
+Ficl Compile-Time Constants
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+There are a lot of preprocessor constants you can set at compile-time
+to modify Ficl's runtime behavior. Some are required, such as telling
+Ficl whether or not the local platform supports double-width integers
+(<code>FICL_PLATFORM_HAS_2INTEGER</code>);
+some are optional, such as telling Ficl whether or not to use the
+extended set of "prefixes" (<code>FICL_WANT_EXTENDED_PREFIXES</code>).
+<p>
+
+The best way to find out more about these constants is to read <code>ficl.h</code>
+yourself. The settings that turn on or off Ficl modules all start with
+<code>FICL_WANT</code>. The settings relating to functionality available
+on the current platform all start with <code>FICL_PLATFORM</code>.
+<p>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='codeficllocalh/code'>
+<code>ficllocal.h</code>
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+One more note about constants. Ficl now ships with a standard place for
+you to tweak the Ficl compile-time preprocessor constants.
+It's a file called <code>ficllocal.h</code>, and we guarantee that it
+will always ship empty (or with only comments). We suggest that you
+put all your local changes there, rather than editing <code>ficl.h</code>
+or editing the makefile. That should make it much easier to integrate
+future Ficl releases into your product—all you need do is preserve
+your tweaked copy of <code>ficllocal.h</code> and replace the rest.
+
+
+
+
+</blockquote><p></td></tr></table></body></html>
+
+
binary files /dev/null b/doc/articles/ficlddj.pdf differ
binary files /dev/null b/doc/articles/jwsforml.pdf differ
--- /dev/null
+++ b/doc/articles/oo_in_c.html
@@ -1,0 +1,223 @@
+<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
+<html>
+<head>
+ <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+ <title>Object Oriented Idioms in C</title>
+</head>
+<body>
+
+<h1>
+<b><font face="Arial"><font size=+1>Object Oriented Idioms in C</font></font></b></h1>
+<font face="Arial"><font size=-1>John Sadler</font></font>
+<br><font face="Arial"><font size=-1>10 Aug 98</font></font>
+<br>
+<br>
+<table COLS=1 WIDTH="675" >
+<tr>
+<td><a NAME="review"></a><b><font face="Arial"><font size=+1>Review of
+Key OO Characteristics</font></font></b>
+<h3>
+<b><i><font face="Arial">Object</font></i></b></h3>
+<a NAME="object-def"></a><font face="Times New Roman,Times"><b>"A package
+of information and descriptions of its manipulation"</b> [<a href="#robson">Robson</a>]</font>
+<p><font face="Times New Roman,Times">Objects separate interface from implementation,
+"what" is wanted (on the outside) from "how" it is accomplished (on the
+inside). This idea of hiding the data inside a package with a fixed set
+of allowed manipulations is called encapsulation. Why? If the object always
+selects how to perform a requested manipulation, you guarantee that the
+procedure and the data it operates on always match.</font>
+<p><font face="Times New Roman,Times">A <b>message</b> denotes an operation
+that can be performed on an <b>object</b>. The code that describes how
+to perform an operation on a specific object type is called a <b>method</b>.
+From the outside, objects receive messages. On the inside, these messages
+are mapped to methods that perform appropriate actions for the specific
+kind of object. An object�s <b>interface</b> is the set of messages to
+which it can respond. For example, several object types may have a "dump"
+method to cause the object to display its state. Each kind of object will
+need a unique method to accomplish this. So the message-method idea separates
+the interface from the implementation. The idea that different kinds of
+objects might invoke different methods to respond to the same message is
+called <b>polymorphism</b>. Methods can be bound to messages as soon as
+the type of the object receiving the message is known (called <b>early
+binding</b>), or this mapping can wait until run-time (<b>late binding</b>).</font>
+<p><font face="Times New Roman,Times">Some languages (notably C++) make
+a syntactic distinction between early and late binding of methods to messages
+(virtual functions are bound late, while all others are bound early � at
+link time). Smalltalk makes no such distinction. The C++ approach has potentially
+dangerous consequences when you manipulate an object through a pointer
+to its parent class. If a method of the superclass is virtual, you get
+late binding to the appropriate function for the object�s class. On the
+other hand, if that method is not virtual, you get early binding to the
+parent class�s definition even if the child class has overridden it. Smalltalk
+adheres rigorously to the idea that the object itself has sole ownership
+of the mapping from methods to messages.</font>
+<br> </td>
+</tr>
+
+<tr>
+<td>
+<h3>
+<b><i><font face="Arial">Class</font></i></b></h3>
+<a NAME="class-def"></a><b><font face="Times New Roman,Times">"A description
+of one or more similar objects"</font></b> [<a href="#robson">Robson</a>]
+<p><a NAME="instance-def"></a>A specific object described by a particular
+class is called an <b>instance</b> of the class.
+<br>(Example: Dog is a class; Poodle is a subclass of Dog; FiFi is an object,
+an instance of Poodle).
+<br>A class is a kind of object that describes the behaviors (methods)
+of its instances, and whose methods provide for creation, initialization,
+and destruction of an instance. All instances of a particular class use
+the same method to respond to a given message. Classes may define other
+members that are shared by all instances of the class. These are called
+class variables. (In C++, these would be static members.)
+<br> </td>
+</tr>
+
+<tr>
+<td>
+<h3>
+<b><i><font face="Arial">Inheritance</font></i></b></h3>
+<font face="Times New Roman,Times">A means for creating a new object or
+class using an existing one as a starting place and defining only what
+changes. C++ only supports class-based inheritance, but some systems also
+allow objects to inherit directly from other objects. At minimum, inheritance
+requires that the child class override its parent�s name. In addition,
+a child class can:</font>
+<ul>
+<li>
+<font face="Times New Roman,Times">add instance variables</font></li>
+
+<li>
+<font face="Times New Roman,Times">add class variables</font></li>
+
+<li>
+<font face="Times New Roman,Times">define methods for new messages</font></li>
+
+<li>
+<font face="Times New Roman,Times">provide methods for (<b>override</b>)
+messages already handled by the parent class</font></li>
+</ul>
+</td>
+</tr>
+
+<tr>
+<td>
+<h3>
+<b><font face="Arial"><font size=+1>What C++ Does for you�</font></font></b></h3>
+<b><i><font face="Arial">Name mangling � separation of name spaces</font></i></b>
+<p><font face="Times New Roman,Times">This mechanism � decorating symbol
+names with extra characters that uniquely identify their class and prototype
+� is the traditional C++ method for operator overloading, method overloading,
+and namespace separation. C provides a much smaller set of namespaces than
+C++ requires, so this strategy allowed C++ to be implemented as a preprocessor
+for C compilers originally.</font>
+<p><b><i><font face="Arial">Rigorous type checking</font></i></b>
+<p>Because of the function prototype requirement and name mangling, a C++
+compiler can provide strict type checking for method invocations.
+<p><b><i><font face="Arial">Automatic lifetime control</font></i></b>
+<p>Guarantees constructor call upon creation and destructor call upon deletion
+<p><b><i><font face="Arial">Multiple Storage classes (same as C)</font></i></b>
+<p>Automatic, static, dynamically allocated
+<p><b><i><font face="Arial">Typed dynamic memory management</font></i></b>
+<p><b><i><font face="Arial">Default constructor, destructor, copy constructor,
+and assignment operator</font></i></b>
+<p><b><i><font face="Arial">Explicit early and late binding support</font></i></b>
+<p><b><i><font face="Arial">And more�</font></i></b>
+<br> </td>
+</tr>
+
+<tr>
+<td>
+<h3>
+<b><font face="Arial"><font size=+1>What other OO languages do (or don�t
+do)</font></font></b></h3>
+Just to make sure we don�t get caught in a C++ centered view of the world,
+here are some ways other OO systems differ.
+<p><b><i><font face="Arial">Run-time type identification</font></i></b>
+<p>This is a Big Deal in C++, but it�s relatively trivial in an interpreted
+language to know the type of a reference at run-time.
+<p><b><i><font face="Arial">Metaclasses</font></i></b>
+<p>Classes are objects, too (Smalltalk, Java?)
+<p><b><i><font face="Arial">Garbage collection</font></i></b>
+<p>Java and smalltalk both manage memory for you, freeing objects when
+they go out of scope or are no longer referenced anywhere.
+<p><b><i><font face="Arial">Single Inheritance only</font></i></b>
+<p>Java, Smalltalk 80
+<p><b><i><font face="Arial">Everything is an object</font></i></b>
+<p>Smalltalk
+<p><b><i><font face="Arial">Operator overloading</font></i></b>
+<p>Smalltalk makes no distinction between operators and other kinds of
+messages. The message syntax is flexible enough that you can define operators
+in the same way as any other kind of message.
+<p><b><i><font face="Arial">Visibility control</font></i></b>
+<p>Smalltalk 80 does not appear to provide options for visibility control
+(based on my quick survey). Instance variables are always private, methods
+are always public as far as I can tell.
+<p><b><i><font face="Arial">Pointers</font></i></b>
+<p>Not in Smalltalk, Java: Both languages deal with objects through implicit
+references. It is still possible to create data structures, but the language
+hides much of the memory management work.
+<p><b><i><font face="Arial">No Casting</font></i></b>
+<p>As far as I can tell, smalltalk has no equivalent of a C/C++ cast.
+<p><b><i><font face="Arial">Late binding</font></i></b>
+<p>Smalltalk makes no syntactic distinction between late and early bound
+methods (unlike C++ "virtual" methods)
+<br> </td>
+</tr>
+
+<tr>
+<td>
+<h3>
+<b><font face="Arial"><font size=+1>OO-C framework options</font></font></b></h3>
+<font face="Times New Roman,Times">Covered: objects (encapsulation, explicit
+construct and destruct), classes, inheritance, polymorphism</font>
+<br><font face="Times New Roman,Times">Not covered: multiple inheritance,
+automatic initialization / destruction,</font>
+<h3>
+<b><font face="Arial"><font size=+1>Strategy 1: message maps and aggregation</font></font></b></h3>
+<font face="Times New Roman,Times">Class: a struct with a pointer to a
+method table (message map). Contructor and destuctor are really initializer
+and destructor, and are invoked manually at beginning and end of lifetime.</font>
+<p><font face="Times New Roman,Times">Messages and methods: mapping table
+(first cut: use macros like MFC to create a mapping between messages and
+methods). Alternative: message map can be built at run-time (hash, tree,
+linked list) � method resolution may be slower.</font>
+<p><font face="Times New Roman,Times">Inheritance: aggregate the parent
+struct (recursively) at the beginning of the derived one, link the child
+method table to the parent and search recursively to resolve messages to
+methods</font>
+<p><font face="Times New Roman,Times">Pros and cons:</font>
+<blockquote><font face="Times New Roman,Times">+ flexible and minimal manual
+steps required</font>
+<br><font face="Times New Roman,Times">+ relatively simple � no need to
+write a preprocessor!</font>
+<br><font face="Times New Roman,Times">- all methods are late bound, run-time
+penalty</font>
+<br><font face="Times New Roman,Times">­ defeats compile time type
+checking, may require a single prototype for all methods</font></blockquote>
+
+<p><br><b><font face="Arial"><font size=+1>Strategy 2: manual name mangling</font></font></b>
+<br><font face="Times New Roman,Times">This is how the <a href="#samek">Samek</a>
+article handles encapsulation</font>
+<p><b><font face="Arial"><font size=+1>Strategy 3: preprocessor</font></font></b>
+<br><font face="Times New Roman,Times">This is how C++ started out.</font>
+<br> </td>
+</tr>
+
+<tr>
+<td><b><font face="Arial"><font size=+1>References</font></font></b>
+<ul>
+<li>
+<a NAME="robson"></a><font size=-1>David Robson, <i>Object Oriented Software
+Systems</i>. Byte, August 1981</font></li>
+
+<li>
+<a NAME="samek"></a><font size=-1>Miro Samek, <i>Portable Inheritance and
+Polymorphism in C</i>. Embedded Systems Programming, December 1997</font></li>
+</ul>
+</td>
+</tr>
+</table>
+
+</body>
+</html>
binary files /dev/null b/doc/articles/sigplan9906.doc differ
--- /dev/null
+++ b/doc/debugger.html
@@ -1,0 +1,259 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>ficl debugger</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+ficl debugger
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+
+<p>Ficl includes a simple step debugger for colon definitions
+and <code>DOES></code> words.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='UsingTheFiclDebugger'>
+Using The Ficl Debugger
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+
+To debug a word, set up the stack with any parameters the word requires,
+then execute:
+<pre><b>DEBUG <i>your-word-name-here</i></b></pre>
+<p>
+
+If the word is unnamed, or all you have is an execution token,
+you can instead use <code>DEBUG-XT</code></b>
+<p>
+
+The debugger invokes <tt>SEE</tt> on the word which prints a crude source
+listing. It then stops at the first instruction of the definition. There are
+six (case insensitive) commands you can use from here onwards:
+
+<dl>
+
+<dt>
+<b>I</b> (step <b>I</b>n)
+<dd>If the next instruction is a colon defintion or does> word, steps into
+that word's code. If the word is a primitive, simply executes the word.
+
+<dt>
+<b>O</b> (step <b>O</b>ver)
+<dd>
+Executes the next instruction in its entirety.
+
+<dt>
+<b>G</b> (<b>G</b>o)
+<dd>
+Run the word to completion and exit the debugger.
+
+<dt>
+<b>L</b> (<b>L</b>ist)
+<dd>
+Lists the source code of the word presently being stepped.
+
+<dt>
+<b>Q</b> (<b>Q</b>uit)
+<dd>
+Abort the word and exit the debugger, clearing the stacks.
+
+<dt>
+<b>X</b> (e<b>X</b>ecute)
+<dd>
+Interpret the remainder of the line as Ficl words. Any change
+they make to the stacks will be preserved when the debugged word
+continues execution.
+Any errors will abort the debug session and reset the VM. Usage example:
+<pre>
+X DROP 3 \ change top argument on stack to 3
+</pre>
+
+</dl>
+
+
+Any other character will prints a list of available debugger commands.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='ThecodeON-STEP/codeEvent'>
+The <code>ON-STEP</code> Event
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+If there is a defined word named <code>ON-STEP</code> when the debugger starts, that
+word will be executed before every step. Its intended use is to display the stacks
+and any other VM state you find interesting. The default <code>ON-STEP</code> is:
+<p>
+
+<pre>
+: ON-STEP ." S: " .S-SIMPLE CR ;
+</pre>
+
+If you redefine <code>ON-STEP</code>, we recommend you ensure the word has no
+side-effects (for instance, adding or removing values from any stack).
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#d0d0d0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=3><b><i>
+<a name='OtherUsefulWordsForDebuggingAndcodeON-STEP/code'>
+Other Useful Words For Debugging And <code>ON-STEP</code>
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<dt>
+<code>.ENV ( -- )</code>
+<dd>
+Prints all environment settings non-destructively.
+
+<dt>
+<code>.S ( -- )</code>
+<dd>
+Prints the parameter stack non-destructively in a verbose format.
+
+<dt>
+<code>.S-SIMPLE ( -- )</code>
+<dd>
+Prints the parameter stack non-destructively in a simple single-line format.
+
+<dt>
+<code>F.S ( -- )</code>
+<dd>
+Prints the float stack non-destructively (only available if <code>FICL_WANT_FLOAT</code> is enabled).
+
+<dt>
+<code>R.S ( -- )</code>
+<dd>
+Prints a represention of the state of the return stack non-destructively.
+
+
+
+</dl>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='DebuggerInternals'>
+Debugger Internals
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<p>
+The debugger words are mostly located in source file <code>tools.c</code>. There are
+supporting words (<code>DEBUG</code> and <code>ON-STEP</code>) in <code>softcore.fr</code> as well.
+There are two main words that make the debugger go: <code>debug-xt</code> and <code>step-break</code>.
+<code>debug-xt</code> takes the execution token of a word to debug (as returned by <code>'</code> for example) ,
+checks to see if it is debuggable (not a primitive), sets a breakpoint at its
+first instruction, and runs <code>see</code> on it. To set a breakpoint,
+<code>debug-xt</code>
+replaces the instruction at the breakpoint with the execution token of <code>step-break</code>, and
+stores the original instruction and its address in a static breakpoint
+record. To clear the breakpoint, <code>step-break</code> simply replaces the original
+instruction and adjusts the target virtual machine's instruction pointer
+to run it.
+
+<p>
+
+<code>step-break</code> is responsible for processing debugger commands and setting
+breakpoints at subsequent instructions.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='FutureEnhancements'>
+Future Enhancements
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<li>
+The debugger needs to exit automatically when it encounters the end of the word
+it was asked to debug. (Perhaps this could be a special kind of breakpoint?)
+
+<li>Add user-set breakpoints.
+
+<li>Add "step out" command.
+</dl>
+
+
+
+</blockquote><p></td></tr></table></body></html>
+
+
--- /dev/null
+++ b/doc/dpans.html
@@ -1,0 +1,1037 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>ficl standards compliance</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+ficl standards compliance
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='ANSRequiredInformation'>
+ANS Required Information
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+
+The following documentation is necessary to comply for Ficl
+to comply with the DPANS94 standard. It describes what areas
+of the standard Ficl implements, what areas it does not, and
+how it behaves in areas undefined by the standard.
+
+<blockquote>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='ANSForthSystem'>
+ANS Forth System
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<b>
+
+Providing names from the Core Extensions word set
+<br>
+
+Providing names from the Double-Number word set
+<br>
+
+Providing the Exception word set
+<br>
+
+Providing the Exception Extensions word set
+<br>
+
+Providing the File-Access word set
+<br>
+
+Providing the File-Access Extensions word set
+<br>
+
+Providing names from the Floating-Point word set
+<br>
+
+Providing the Locals word set
+<br>
+
+Providing the Locals Extensions word set
+<br>
+
+Providing the Memory Allocation word set
+<br>
+
+Providing the Programming-Tools word set
+<br>
+
+Providing names from the Programming-Tools Extensions word set
+<br>
+
+Providing the Search-Order word set
+<br>
+
+Providing the Search-Order Extensions word set
+<br>
+
+Providing names from the String Extensions word set
+<br>
+
+</b>
+
+
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='Implementation-definedOptions'>
+Implementation-defined Options
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+The implementation-defined items in the following list represent
+characteristics and choices left to the discretion of the implementor,
+provided that the requirements of the Standard are met. A system shall
+document the values for, or behaviors of, each item.
+
+<dl>
+
+<dt><b>
+aligned address requirements (3.1.3.3 Addresses)
+</b><dd>
+
+
+
+System dependent. You can change the default address alignment by
+defining <code>FICL_ALIGN</code> on your compiler's command line,
+or in <code>platform.h</code>.
+The default value is set to 2 in <code>ficl.h</code>.
+This causes dictionary entries and <code>ALIGN</code> and
+<code>ALIGNED</code> to align on 4 byte
+boundaries. To align on 2<b><sup>n</sup></b> byte boundaries,
+set <code>FICL_ALIGN</code> to <b>n</b>.
+
+
+<dt><b>
+behavior of 6.1.1320 EMIT for non-graphic characters
+</b><dd>
+
+
+
+Depends on target system, C runtime library, and your
+implementation of <code>ficlTextOut()</code>.
+
+
+<dt><b>
+character editing of 6.1.0695 ACCEPT and 6.2.1390 EXPECT
+</b><dd>
+
+
+
+None implemented in the versions supplied in <code>primitives.c</code>.
+Because <code>ficlEvaluate()</code> is supplied a text buffer
+externally, it's up to your system to define how that buffer will
+be obtained.
+
+
+<dt><b>
+character set (3.1.2 Character types, 6.1.1320 EMIT, 6.1.1750 KEY)
+</b><dd>
+
+
+
+Depends on target system and implementation of <code>ficlTextOut()</code>.
+
+
+<dt><b>
+character-aligned address requirements (3.1.3.3 Addresses)
+</b><dd>
+
+
+
+Ficl characters are one byte each. There are no alignment requirements.
+
+
+<dt><b>
+character-set-extensions matching characteristics (3.4.2 Finding definition names)
+</b><dd>
+
+
+
+No special processing is performed on characters beyond case-folding. Therefore,
+extended characters will not match their unaccented counterparts.
+
+
+<dt><b>
+conditions under which control characters match a space delimiter (3.4.1.1 Delimiters)
+</b><dd>
+
+
+
+Ficl uses the Standard C function <code>isspace()</code> to distinguish space characters.
+
+
+<dt><b>
+format of the control-flow stack (3.2.3.2 Control-flow stack)
+</b><dd>
+
+
+
+Uses the data stack.
+
+
+<dt><b>
+conversion of digits larger than thirty-five (3.2.1.2 Digit conversion)
+</b><dd>
+
+
+
+The maximum supported value of <code>BASE</code> is 36.
+Ficl will fail via assertion in function <code>ltoa()</code> of <code>utility.c</code>
+if the base is found to be larger than 36 or smaller than 2. There will be no effect
+if <code>NDEBUG</code> is defined, however, other than possibly unexpected behavior.
+
+
+<dt><b>
+display after input terminates in 6.1.0695 ACCEPT and 6.2.1390 EXPECT
+</b><dd>
+
+
+
+Target system dependent.
+
+
+<dt><b>
+exception abort sequence (as in 6.1.0680 ABORT")
+</b><dd>
+
+
+
+Calls <tt>ABORT</tt> to exit.
+
+
+<dt><b>
+input line terminator (3.2.4.1 User input device)
+</b><dd>
+
+
+
+Target system dependent (implementation of outer loop that calls <code>ficlEvaluate()</code>).
+
+
+<dt><b>
+maximum size of a counted string, in characters (3.1.3.4 Counted strings, 6.1.2450 WORD)
+</b><dd>
+
+
+
+Counted strings are limited to 255 characters.
+
+
+<dt><b>
+maximum size of a parsed string (3.4.1 Parsing)
+</b><dd>
+
+
+
+Limited by available memory and the maximum unsigned value that can fit in a cell (2<sup>32</sup>-1).
+
+
+<dt><b>
+maximum size of a definition name, in characters (3.3.1.2 Definition names)
+</b><dd>
+
+
+
+Ficl stores the first 31 characters of a definition name.
+
+
+<dt><b>
+maximum string length for 6.1.1345 ENVIRONMENT?, in characters
+</b><dd>
+
+
+
+Same as maximum definition name length.
+
+
+<dt><b>
+method of selecting 3.2.4.1 User input device
+</b><dd>
+
+
+
+None supported. This is up to the target system.
+
+
+<dt><b>
+method of selecting 3.2.4.2 User output device
+</b><dd>
+
+
+
+None supported. This is up to the target system.
+
+
+<dt><b>
+methods of dictionary compilation (3.3 The Forth dictionary)
+</b><dd>
+
+
+
+Okay, we don't know what this means. If you understand what they're asking for here,
+please call the home office.
+
+
+<dt><b>
+number of bits in one address unit (3.1.3.3 Addresses)
+</b><dd>
+
+
+
+Target system dependent, either 32 or 64 bits.
+
+
+<dt><b>
+number representation and arithmetic (3.2.1.1 Internal number representation)
+</b><dd>
+
+
+
+System dependent. Ficl represents a CELL internally as a union that can hold a <code>ficlInteger32</code>
+(a signed 32 bit scalar value), a <code>ficlUnsigned32</code> (32 bits unsigned),
+and an untyped pointer. No specific byte ordering is assumed.
+
+
+<dt><b>
+ranges for n, +n, u, d, +d, and ud (3.1.3 Single-cell types, 3.1.4 Cell-pair types)
+</b><dd>
+
+
+
+System dependent.
+Assuming a 32 bit implementation, range for signed single-cell values is [-2<sup>31</sup>, 2<sup>31</sup>-1].
+Range for unsigned single cell values is [0, 2<sup>32</sup>-1].
+Range for signed double-cell values is [-2<sup>63</sup>, 2<sup>63</sup>-1].
+Range for unsigned double cell values is [0, 2<sup>64</sup>-1].
+
+
+<dt><b>
+read-only data-space regions (3.3.3 Data space)
+</b><dd>
+
+
+
+None.
+
+
+<dt><b>
+size of buffer at 6.1.2450 WORD (3.3.3.6 Other transient regions)
+</b><dd>
+
+
+
+Default is 255. Depends on the setting of <code>FICL_PAD_SIZE</code> in <code>ficl.h</code>.
+
+
+<dt><b>
+size of one cell in address units (3.1.3 Single-cell types)
+</b><dd>
+
+
+
+System dependent, generally 4.
+
+
+<dt><b>
+size of one character in address units (3.1.2 Character types)
+</b><dd>
+
+
+
+System dependent, generally 1.
+
+
+<dt><b>
+size of the keyboard terminal input buffer (3.3.3.5 Input buffers)
+</b><dd>
+
+
+
+This buffer is supplied by the host program. Ficl imposes no practical limit.
+
+
+<dt><b>
+size of the pictured numeric output string buffer (3.3.3.6 Other transient regions)
+</b><dd>
+
+
+
+Default is 255. Depends on the setting of <code>FICL_PAD_SIZE</code> in <code>ficl.h</code>.
+
+
+<dt><b>
+size of the scratch area whose address is returned by 6.2.2000 PAD (3.3.3.6 Other transient regions)
+</b><dd>
+
+
+
+Default is 255. Depends on the setting of <code>FICL_PAD_SIZE</code> in <code>ficl.h</code>.
+
+
+<dt><b>
+system case-sensitivity characteristics (3.4.2 Finding definition names)
+</b><dd>
+
+
+
+The Ficl dictionary is not case-sensitive.
+
+
+<dt><b>
+system prompt (3.4 The Forth text interpreter, 6.1.2050 QUIT)
+</b><dd>
+
+
+
+<code>ok></code>
+
+
+<dt><b>
+type of division rounding (3.2.2.1 Integer division, 6.1.0100 */, 6.1.0110 */MOD, 6.1.0230 /, 6.1.0240 /MOD, 6.1.1890 MOD)
+</b><dd>
+
+
+
+Symmetric.
+
+
+<dt><b>
+values of 6.1.2250 STATE when true
+</b><dd>
+
+
+
+1.
+
+
+<dt><b>
+values returned after arithmetic overflow (3.2.2.2 Other integer operations)
+</b><dd>
+
+
+
+System dependent. Ficl makes no special checks for overflow.
+
+
+<dt><b>
+whether the current definition can be found after 6.1.1250 DOES> (6.1.0450 :)
+</b><dd>
+
+
+No. Definitions are unsmudged after ; only, and only then if no control structure matching problems have been detected.
+
+</dl>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='AmbiguousConditions'>
+Ambiguous Conditions
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<dt><b>
+a name is neither a valid definition name nor a valid number during text interpretation (3.4 The Forth text interpreter)
+</b><dd>
+
+
+
+Ficl calls <code>ABORT</code> then prints the name followed by <code>not found</code>.
+
+
+<dt><b>
+a definition name exceeded the maximum length allowed (3.3.1.2 Definition names)
+</b><dd>
+
+
+
+Ficl stores the first 31 characters of the definition name, and uses all characters of the name
+in computing its hash code. The actual length of the name, up to 255 characters, is stored in
+the definition's length field.
+
+
+<dt><b>
+addressing a region not listed in 3.3.3 Data Space
+</b><dd>
+
+
+
+No problem: all addresses in Ficl are absolute. You can reach any 32 bit address in Ficl's address space.
+
+
+<dt><b>
+argument type incompatible with specified input parameter, e.g., passing a flag to a word expecting an n (3.1 Data types)
+</b><dd>
+
+
+
+Ficl makes no check for argument type compatibility. Effects of a mismatch vary widely depending on the specific problem and operands.
+
+
+<dt><b>
+attempting to obtain the execution token, (e.g., with 6.1.0070 ', 6.1.1550 FIND, etc.) of a definition with undefined interpretation semantics
+</b><dd>
+
+
+
+Ficl returns a valid token, but the result of executing that token while interpreting may be undesirable.
+
+
+<dt><b>
+dividing by zero (6.1.0100 */, 6.1.0110 */MOD, 6.1.0230 /, 6.1.0240 /MOD, 6.1.1561 FM/MOD, 6.1.1890 MOD, 6.1.2214 SM/REM, 6.1.2370 UM/MOD, 8.6.1.1820 M*/)
+</b><dd>
+
+
+
+Results are target procesor dependent. Generally, Ficl makes no check for divide-by-zero. The target processor will probably throw an exception.
+
+
+<dt><b>
+insufficient data-stack space or return-stack space (stack overflow)
+</b><dd>
+
+
+
+With <code>FICL_ROBUST</code> (defined in <code>ficl.h</code>) set to a value of 2 or greater,
+most data, float, and return stack operations are checked for underflow and overflow.
+
+
+<dt><b>
+insufficient space for loop-control parameters
+</b><dd>
+
+
+
+This is not checked, and bad things will happen.
+
+
+<dt><b>
+insufficient space in the dictionary
+</b><dd>
+
+
+
+Ficl generates an error message if the dictionary is too full to create
+a definition header. It checks <code>ALLOT</code> as well, but it is possible
+to make an unchecked allocation request that will overflow the dictionary.
+
+
+<dt><b>
+interpreting a word with undefined interpretation semantics
+</b><dd>
+
+
+
+Ficl protects all ANS Forth words with undefined interpretation semantics from being executed while in interpret state.
+It is possible to defeat this protection using ' (tick) and <code>EXECUTE</code> though.
+
+
+<dt><b>
+modifying the contents of the input buffer or a string literal (3.3.3.4 Text-literal regions, 3.3.3.5 Input buffers)
+</b><dd>
+
+
+
+Varies depending on the nature of the buffer. The input buffer is supplied by ficl's host function, and may reside
+in read-only memory. If so, writing the input buffer can ganerate an exception.
+String literals are stored in the dictionary, and are writable.
+
+
+<dt><b>
+overflow of a pictured numeric output string
+</b><dd>
+
+
+
+In the unlikely event you are able to construct a pictured numeric string of more
+than <code>FICL_PAD_LENGTH</code> characters, the system will be corrupted unpredictably.
+The buffer area that holds pictured numeric output is at the end of the virtual machine.
+Whatever is mapped after the offending VM in memory will be trashed, along with the heap
+structures that contain it.
+
+
+<dt><b>
+parsed string overflow
+</b><dd>
+
+
+
+Ficl does not copy parsed strings unless asked to. Ordinarily, a string parsed from the input buffer during
+normal interpretation is left in-place, so there is no possibility of overflow.
+If you ask to parse a string into the dictionary, as in <code>SLITERAL</code>, you need to have enough
+room for the string, otherwise bad things may happen. This is usually not a problem.
+
+
+<dt><b>
+producing a result out of range, e.g., multiplication (using *) results in a value too big to be represented by a single-cell integer (6.1.0090 *, 6.1.0100 */, 6.1.0110 */MOD, 6.1.0570, >NUMBER, 6.1.1561 FM/MOD, 6.1.2214 SM/REM, 6.1.2370 UM/MOD, 6.2.0970 CONVERT, 8.6.1.1820 M*/)
+</b><dd>
+
+
+
+Value will be truncated.
+
+
+<dt><b>
+reading from an empty data stack or return stack (stack underflow)
+</b><dd>
+
+
+
+Most stack underflows are detected and prevented if <code>FICL_ROBUST</code> (defined in <code>sysdep.h</code>) is set to 2 or greater.
+Otherwise, the stack pointer and size are likely to be trashed.
+
+
+<dt><b>
+unexpected end of input buffer, resulting in an attempt to use a zero-length string as a name
+</b><dd>
+
+
+
+Ficl returns for a new input buffer until a non-empty one is supplied.
+
+
+</dl>
+
+
+The following specific ambiguous conditions are noted in the glossary entries of the relevant words:
+
+<dl>
+
+<dt><b>
+>IN greater than size of input buffer (3.4.1 Parsing)
+</b><dd>
+
+
+
+Memory corruption will occur—the exact behavior is unpredictable
+because the input buffer is supplied by the host program's outer loop.
+
+
+<dt><b>
+6.1.2120 RECURSE appears after 6.1.1250 DOES>
+</b><dd>
+
+
+
+It finds the address of the definition before <code>DOES></code>
+
+
+<dt><b>
+argument input source different than current input source for 6.2.2148 RESTORE-INPUT
+</b><dd>
+
+
+
+Not implemented.
+
+
+<dt><b>
+data space containing definitions is de-allocated (3.3.3.2 Contiguous regions)
+</b><dd>
+
+
+
+This is okay until the cells are overwritten with something else.
+The dictionary maintains a hash table, and the table must be updated
+in order to de-allocate words without corruption.
+
+
+<dt><b>
+data space read/write with incorrect alignment (3.3.3.1 Address alignment)
+</b><dd>
+
+
+
+Target processor dependent. Consequences include: none (Intel), address error exception (68K).
+
+
+<dt><b>
+data-space pointer not properly aligned (6.1.0150 ,, 6.1.0860 C,)
+</b><dd>
+
+
+
+See above on data space read/write alignment.
+
+<dt><b>
+less than u+2 stack items (6.2.2030 PICK, 6.2.2150 ROLL)
+</b><dd>
+
+
+
+If <code>FICL_ROBUST</code> is two or larger, Ficl will detect a stack underflow, report it, and execute <code>ABORT</code> to
+exit execution. Otherwise the error will not be detected, and memory corruption will occur.
+
+
+<dt><b>
+loop-control parameters not available ( 6.1.0140 +LOOP, 6.1.1680 I, 6.1.1730 J, 6.1.1760 LEAVE, 6.1.1800 LOOP, 6.1.2380 UNLOOP)
+</b><dd>
+
+
+
+Loop initiation words are responsible for checking the stack and guaranteeing that the control parameters are pushed.
+Any underflows will be detected early if <code>FICL_ROBUST</code> is set to 2 or greater.
+Note however that Ficl only checks for return stack underflows at the end of each line of text.
+
+<dt><b>
+most recent definition does not have a name (6.1.1710 IMMEDIATE)
+</b><dd>
+
+
+
+No problem.
+
+
+<dt><b>
+name not defined by 6.2.2405 VALUE used by 6.2.2295 TO
+</b><dd>
+
+
+
+Ficl's version of <code>TO</code> works correctly with words defined with:
+<ul>
+
+<li> <code>VALUE</code>
+<li> <code>2VALUE</code>
+<li> <code>FVALUE</code>
+<li> <code>F2VALUE</code>
+<li> <code>CONSTANT</code>
+<li> <code>FCONSTANT</code>
+<li> <code>2CONSTANT</code>
+<li> <code>F2CONSTANT</code>
+<li> <code>VARIABLE</code>
+<li> <code>2VARIABLE</code>
+</ul>
+as well as with all "local" variables.
+
+<dt><b>
+name not found (6.1.0070 ', 6.1.2033 POSTPONE, 6.1.2510 ['], 6.2.2530 [COMPILE])
+</b><dd>
+
+
+
+Ficl prints an error message and executes <code>ABORT</code>
+
+<dt><b>
+parameters are not of the same type (6.1.1240 DO, 6.2.0620 ?DO, 6.2.2440 WITHIN)
+</b><dd>
+
+
+
+Not detected. Results vary depending on the specific problem.
+
+
+<dt><b>
+6.1.2033 POSTPONE or 6.2.2530 [COMPILE] applied to 6.2.2295 TO
+</b><dd>
+
+
+
+The word is postponed correctly.
+
+
+<dt><b>
+string longer than a counted string returned by 6.1.2450 WORD
+</b><dd>
+
+
+
+Ficl stores the first <code>FICL_COUNTED_STRING_MAX</code> - 1 characters in the
+destination buffer.
+(The extra character is the trailing space required by the standard. Yuck.)
+
+<dt><b>
+u greater than or equal to the number of bits in a cell (6.1.1805 LSHIFT, 6.1.2162 RSHIFT)
+</b><dd>
+
+
+
+Depends on target process or and C runtime library implementations of the << and >> operators
+on unsigned values. For I386, the processor appears to shift modulo the number of bits in a cell.
+
+<dt><b>
+word not defined via 6.1.1000 CREATE (6.1.0550 >BODY, 6.1.1250 DOES>)
+</b><dd>
+
+
+
+<dt><b>
+words improperly used outside 6.1.0490 <# and 6.1.0040 #> (6.1.0030 #, 6.1.0050 #S, 6.1.1670 HOLD, 6.1.2210 SIGN)
+</b><dd>
+
+
+
+Undefined. <code>CREATE</code> reserves a field in words it builds for <code>DOES></code> to fill in.
+If you use <code>DOES></code> on a word not made by <code>CREATE</code> it will overwrite the first
+cell of its parameter area. That's probably not what you want. Likewise, pictured numeric words
+assume that there is a string under construction in the VM's scratch buffer. If that's not the case,
+results may be unpleasant.
+
+
+</dl>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='LocalsImplementation-DefinedOptions'>
+Locals Implementation-Defined Options
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<dt><b>
+maximum number of locals in a definition (13.3.3 Processing locals, 13.6.2.1795 LOCALS|)
+</b><dd>
+
+
+
+Default is 64—unused locals are cheap. Change by redefining <code>FICL_MAX_LOCALS</code> (defined in <code>ficl.h</code>).
+
+</dl>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='LocalsAmbiguousconditions'>
+Locals Ambiguous conditions
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<dt><b>
+executing a named local while in interpretation state (13.6.1.0086 (LOCAL))
+</b><dd>
+
+
+
+Locals can be found in interpretation state while in the context of a definition under
+construction. Under these circumstances, locals behave correctly. Locals are not visible
+at all outside the scope of a definition.
+
+<dt><b>
+name not defined by VALUE or LOCAL (13.6.1.2295 TO)
+</b><dd>
+
+
+
+See the CORE ambiguous conditions, above (no change).
+
+</dl>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='ProgrammingToolsImplementation-DefinedOptions'>
+Programming Tools Implementation-Defined Options
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+
+<dl>
+
+<dt><b>
+source and format of display by 15.6.1.2194 SEE
+</b><dd>
+
+
+
+<code>SEE</code> de-compiles definitions from the dictionary. Ficl words are stored as a combination
+of things:
+<ol>
+
+<li>bytecodes (identified as "instructions"),
+<li>addresses of native Ficl functions, and
+<li>arguments to both of the above.
+
+</ol>
+Colon definitions are decompiled. Branching instructions indicate their destination,
+but target labels are not reconstructed.
+Literals and string literals are so noted, and their contents displayed.
+
+</dl>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='SearchOrderImplementation-DefinedOptions'>
+Search Order Implementation-Defined Options
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+
+<dl>
+
+<dt><b>
+maximum number of word lists in the search order (16.3.3 Finding definition names, 16.6.1.2197 SET-ORDER)
+</b><dd>
+
+
+
+Defaults to 16. Can be changed by redefining <code>FICL_MAX_WORDLISTS</code> (declared in <code>ficl.h</code>).
+
+
+<dt><b>
+minimum search order (16.6.1.2197 SET-ORDER, 16.6.2.1965 ONLY)
+</b><dd>
+
+
+
+Equivalent to <code>FORTH-WORDLIST 1 SET-ORDER</code>
+
+</dl>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='SearchOrderAmbiguousConditions'>
+Search Order Ambiguous Conditions
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+
+<dl>
+<dt><b>
+changing the compilation word list (16.3.3 Finding definition names)
+</b><dd>
+
+
+
+Ficl stores a link to the current definition independently of the compile wordlist while
+it is being defined, and links it into the compile wordlist only after the definition completes
+successfully. Changing the compile wordlist mid-definition will cause the definition to link
+into the <i>new</i> compile wordlist.
+
+
+<dt><b>
+search order empty (16.6.2.2037 PREVIOUS)
+</b><dd>
+
+
+
+Ficl prints an error message if the search order underflows, and resets the order to its default state.
+
+
+<dt><b>
+too many word lists in search order (16.6.2.0715 ALSO)
+</b><dd>
+
+
+
+Ficl prints an error message if the search order overflows, and resets the order to its default state.
+
+</dl>
+
+
+
+</blockquote><p></td></tr></table></body></html>
+
+
binary files /dev/null b/doc/favicon.ico differ
--- /dev/null
+++ b/doc/ficl.html
@@ -1,0 +1,1269 @@
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+<!DOCTYPE html PUBLIC "-//w3c//dtd html 4.0 transitional//en">
+
+<html>
+<head>
+ <meta name="Author" content="john sadler">
+ <meta name="Description" content="Ficl - embedded scripting with object oriented programming">
+ <meta name="Keywords" content="scripting prototyping tcl OOP Forth interpreter C">
+ <link rel="SHORTCUT ICON" href="favicon.ico">
+ <title>Ficl - Embedded Scripting</title>
+</head>
+
+<body>
+
+<h1>Ficl Documentation</h1>
+
+<script language="javascript" src="ficlheader.js" type="text/javascript">
+</script>
+
+<h1><a name="whatis">What is Ficl?</a></h1>
+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. Unlike other
+scripting interpreters, Ficl:
+
+<ul>
+
+<li>
+typically takes under 2 hours to port to a new system—much
+less if the target operating system is one of several already supported
+(Win32, Linux, FreeBSD, RiscOS, and more)
+
+<li>
+has a small memory footprint: a fully featured Win32 console
+version takes less than 100K of memory, and a minimal version is less
+than half that
+
+<li>
+is relatively quick thanks to its "switch-threaded" virtual
+machine design and just in time compiling
+
+<li>
+is a complete and powerful programming language
+
+<li>
+is interactive
+
+<li>
+has object oriented programming features that can be used to wrap
+data structures or classes of the host system without altering them—even
+if the host is mainly written in a non-OO language
+
+</ul>
+
+<p>
+
+Ficl syntax is based on ANS Forth and the code is ANSI C. See
+below for examples of <a href="#includesficl">software and products
+that include ficl</a>. Ficl stands for "Forth inspired command language".
+
+
+<h3>Ficl Versus Other Forth Interpreters</h3>
+
+Where most Forths 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). In addition, Ficl provides a simple
+and powerful object model that can act as an object oriented <i>adapter</i>
+for code written in C (or asm, Forth, C++...).
+
+
+<h3>Ficl Design Goals</h3>
+<ul>
+
+<li>
+Target 32- and 64-bit processors
+
+<li>
+Scripting, prototyping, and extension language for systems
+written also in C
+
+<li>
+Supportable—code is as transparent as I can make it
+
+<li>
+Interface to functions written in C
+
+<li>
+Conformant to the 1994 ANSI Standard for Forth (DPANS94)
+
+<li>
+Minimize porting effort—require an ANSI C runtime environment
+and minimal glue code
+
+<li>
+Provide object oriented extensions
+
+</ul>
+
+<hr>
+
+<h2><a name="download">Download</a></h2>
+
+<ul>
+
+<li> <b><a href="http://sourceforge.net/project/showfiles.php?group_id=24441">Download Ficl (latest release)</a></b>
+
+</ul>
+
+<h2><a name="links">More information on Ficl and Forth</a></h2>
+
+<ul>
+
+<li>
+<a href="http://ficl.sourceforge.net">Web home of Ficl</a>
+
+<li>
+<a href="http://ficl.sourceforge.net/pdf/Forth_Primer.pdf">
+An excellent Forth Primer by Hans Bezemer
+</a>
+
+<li>
+<a href="ficlddj.pdf">
+Manuscript of Ficl article for January 1999 Dr. Dobb's Journal
+</a>
+
+<li>
+<a href="jwsforml.pdf">
+1998 FORML Conference paper—OO Programming in Ficl
+</a>
+
+<li>
+<a href="http://www.taygeta.com/forth_intro/stackflo.html">
+An Introduction to Forth using Stack Flow
+</a>
+(start here if you're new to Forth)
+
+<li>
+<a href="http://www.softsynth.com/pforth/pf_tut.htm">
+Phil Burk's Forth Tutorial
+</a>
+
+<li>
+<a href="http://www.complang.tuwien.ac.at/forth/threaded-code.html">
+Anton Ertl's description of Threaded Code
+</a>
+(Ficl now uses what he calls "switch threading")
+
+<li>
+<a href="http://ficl.sourceforge.net/dpans/dpans.htm">
+Draft Proposed American National Standard for Forth
+</a>
+(quite readable, actually)
+
+<li>
+<a href="http://www.taygeta.com/forthlit.html">
+Forth literature index on Taygeta
+</a>
+
+<li>
+<a href="http://www.forth.org">
+Forth Interest Group
+</a>
+
+</ul>
+
+<h2><a name="includesficl">Some software that uses Ficl</a></h2>
+
+<ul>
+<li>
+The <a href="http://www.freebsd.org/">FreeBSD</a> boot loader
+(Daniel Sobral, Jordan Hubbard)
+
+<li>
+<a href="http://www.chipcenter.com/networking/images/prod/prod158a.pdf">
+SwitchCore
+</a>
+Gigabit Ethernet switches (Örjan Gustavsson )
+
+<li>
+<a href="http://debuffer.sourceforge.net/">
+Palm Pilot Debuffer
+</a>
+(Eric Sessoms) Also see ficlx, a C++ interface to ficl, on the same site
+
+<li>
+<a href="http://www.swcp.com/%7Ejchavez/osmond.html">
+Osmond PC Board Layout tool
+</a>
+
+<li>
+<a href="http://www.netcomsystems.com">
+NetCom Systems
+</a>
+ML7710
+
+<li>
+<a href="http://www.parview.com/ds/homepage.html">
+ParView
+</a>
+GPS system
+
+<li>
+<a href="http://www.thekompany.com/products/powerplant/software/Languages/Embedded.php3">
+PowerPlant Software
+</a>
+Development Environment for Linux
+
+<li>
+<a href="http://www.vyyo.com/products/architecture_v3000.html">
+Vyyo V3000 Broadband Wireless Hub
+</a>
+
+<li>
+<a href="mailto:[email protected]">
+<i>Your Product Name Here!!!</i>
+</a>
+
+</ul>
+
+
+<hr>
+<h2><a name="lawyerbait">License And Disclaimer</a></h2>
+
+Copyright (c) 1997-2001 John Sadler ([email protected])
+<br>
+All rights reserved.
+<p>
+
+<b>
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+<ol>
+
+<li>
+Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+<li>
+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.
+
+</ol>
+
+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.
+</b>
+<p>
+
+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
+<a href="mailto:[email protected]">send me email</a>.
+<p>
+
+
+<h2><a name="features">Ficl Features</a></h2>
+
+<ul>
+
+<li>
+Simple to integrate into existing systems: the sample
+implementation requires three Ficl function calls (see the example
+program in <b>main.c</b>).
+
+<li>
+Written in ANSI C for portability.
+
+<li>
+Standard: Implements the ANS Forth CORE word set, part of the
+CORE EXT word set, SEARCH and SEARCH EXT, TOOLS and part of TOOLS EXT,
+LOCAL and LOCAL EXT, EXCEPTION, MEMORY, and various extras.
+
+<li>
+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 (not surprising if you're familiar with Forth)
+
+<li>
+Ficl and C/C++ can interact in two ways: Ficl can wrap C code,
+and C functions can invoke Ficl code.
+
+<li>
+Ficl code is thread safe and re-entrant: your program can have one or more
+Ficl "systems", and each "system" can have one or Ficl virtual machines.
+Each Ficl virtual machine has an otherwise complete state, and each can
+be bound to a separate I/O channel (or none at all).
+An optional function called ficlLockDictionary() can control
+exclusive dictionary access. This function is stubbed out by
+default (See FICL_MULTITHREAD in sysdep.h). As long as there is only
+one "session" that can compile words into the dictionary, you do not
+need exclusive dictionary access for multithreading.
+<b>Note</b>:
+while the code is re-entrant, there are still restrictions on how you
+can use it safely in a multithreaded system. Specifically, the VM
+itself maintains state, so you generally need a VM per thread in a
+multithreaded system. If interrupt service routines make calls into Ficl
+code that alters VM state, then these generally need their
+own VM as well. Alternatively, you could provide a mutual exclusion
+mechanism to serialize access to a VM from multiple threads.
+
+<li>
+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.
+
+<li>
+Written in ANSI C to be as simple as I can make it to understand,
+support, debug, and port. Compiles without complaint at <code>/Az /W4</code> (require
+ANSI C, max. warnings) under Microsoft Visual C++, and <code>-ansi</code>
+under GCC. Ports to several other toolchains and operating systems
+(notably FreeBSD and Linux flavors) exist.
+
+<li> Does full 32 bit math (but you need to implement two mixed
+precision math primitives (see sysdep.c)) </li>
+
+</ul>
+
+<hr>
+
+<h2><a name="porting">Porting Ficl</a></h2>
+
+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 <b>sysdep.h</tt> and <tt>sysdep.c</tt> and edit them to suit
+your system. For example, <tt>INT16</tt> is a <tt>short</tt> on some
+compilers and an <tt>int</tt> on others. Check the default <tt>CELL</tt>
+alignment controlled by <tt> FICL_ALIGN</tt>. If necessary, add new
+definitions of <tt>ficlMalloc, ficlFree, ficlRealloc</tt>, and <tt>ficlTextOut</tt>
+to work with your operating system. Finally, use <tt>testmain.c</tt> as
+a guide to installing the ficl system and one or more virtual machines
+into your code. You do not need to include <tt>testmain.c</tt> in your
+build.
+<p>
+Note: ficlLockDictionary can be left unimplemented in most
+multithreaded implementations - it's only necessary if you expect to
+have more than one thread modifying the dictionary at the same
+time. If you do decide to implement it, make sure calls to
+ficlLockDictionary can nest properly (see the comments in sysdep.h). You
+need to keep count of nested locks and unlocks and do the right
+thing.
+<p>
+
+Feel free to stub out the double precision math functions (which are
+presently implemented as inline assembly because it's so easy on many 32
+bit processors) with kludge code that only goes to 32 bit
+precision. In most applications, you won't notice the difference. If
+you're doing a lot of number crunching, consider implementing them
+correctly.
+
+
+<h3>Build Controls</h3>
+
+The file sysdep.h contains default values for build controls. Most of
+these are written such that if you define them on the compiler command
+line, the defaults are overridden. I suggest you take the defaults
+on everything below the "build controls" section until you're confident
+of your port. Beware of declaring too small a dictionary, for example.
+You need about 3200 cells for a full system, about 2000 if you
+strip out most of the "soft" words.
+
+<h3>Softcore</h3>
+Many words from all the supported wordsets are written in Forth, and
+stored as a big string that Ficl compiles when it starts. The sources
+for all of these words are in directory <b>softcore</b>. There is a
+.bat file (softcore.bat) and a PERL 5 script (softcore.pl) that convert
+Forth files into the file softcore.c, so softcore.c is really dependent
+on the Forth sources. This is not reflected in the Visual C++ project
+database. For the time being, it's a manual step. You can edit
+<b>make.bat</b> to change the list of files that contribute to
+<b>softcore.c</b>.
+
+<h3>To-Do List (target system dependent words)</h3>
+
+<ul>
+
+<li>
+Unimplemented system dependent <tt>CORE</tt> word: <tt>KEY</tt>
+(implement this yourself if you need it)
+
+<li>
+Kludged <tt>CORE</tt> word: <tt>ACCEPT</tt> (implement this
+better if you need to)
+
+</ul>
+
+<h2><a name="api">Application Programming Interface</a></h2>
+
+The following is a partial listing of functions that interface your
+system or program to Ficl. For a complete listing, see <b>ficl.h</b>
+(which is heavily commented). For examples, see <b>main.c</b> and the
+FiclWin sources (<a href="#download">below</a>).
+
+<dl>
+ <dt> <b>FICL_SYSTEM *ficlInitSystem(int nDictCells)</b> </dt>
+ <dd> Initializes Ficl's shared system data structures, and creates the
+dictionary allocating the specified number of CELLs from the heap (by a
+call to ficlMalloc) </dd>
+ <dt> <b>void ficlTermSystem(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Reclaims memory allocated for the ficl system including all
+dictionaries and all virtual machines created by vmCreate. Any uses of
+the memory allocation words (allocate and resize) are your
+problem. </dd>
+ <dt> <b>int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code,
+char flags)</b> </dt>
+ <dd> Create a primitive word in ficl's main dictionary with the given
+name, code pointer, and properties (immediate, compile only, etc) as
+described by the flags (see ficl.h for flag descriptions of
+the form FW_XXXX) </dd>
+ <dt> <b>int ficlExec(FICL_VM *pVM, char *text)</b> </dt>
+ <dd> Feed the specified C string ('\0' terminated) to the given+virtual machine for evaluation. Returns various exception codes (VM_XXXX
+in ficl.h) to indicate the reason for returning. Normal exit
+condition is VM_OUTOFTEXT, indicating that the VM consumed the string
+successfully and is back for more. ficlExec calls can be nested, and
+the function itself is re-entrant, but note that a VM is
+static, so you have to take reasonable precautions (for example, use one
+VM per thread in a multithreaded system if you want multiple threads to
+be able to execute commands). </dd>
+ <dt> <b>int ficlExecC(FICL_VM *pVM, char *text, int nChars)</b> </dt>
+ <dd> Same as ficlExec, but takes a count indicating the length of the
+supplied string. Setting nChars to -1 is equivalent to ficlExec (expects
+'\0' termination). </dd>
+ <dt> <b>int ficlExecXT(FICL_VM *pVM, FICL_WORD *pFW)</b> </dt>
+ <dd> Same as ficlExec, but takes a pointer to a FICL_WORD instead of a
+string. Executes the word and returns after it has finished. If
+executing the word results in an exception, this function will
+re-throw the same code if it is nested under another ficlExec family
+function, or return the exception code directly if not. This function
+is useful if you need to execute the same word repeatedly -
+you save the dictionary search and outer interpreter overhead. </dd>
+ <dt> <b>void ficlFreeVM(FICL_VM *pVM)</b> </dt>
+ <dd> 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. </dd>
+ <dt> <b>FICL_VM *ficlNewVM(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Create, initialize, and return a VM from the heap using
+ficlMalloc. Links the VM into the system VM list for later reclamation
+by ficlTermSystem. </dd>
+ <dt> <b>FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name)</b> </dt>
+ <dd> Returns the address (also known as an XT in this case) of the
+specified word in the main dictionary. If not found, returns NULL. The
+address can be used in a call to ficlExecXT. </dd>
+ <dt> <b>FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Returns a pointer to the main system dictionary, or NULL if the
+system is uninitialized. </dd>
+ <dt> <b>FICL_DICT *ficlGetEnv(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Returns a pointer to the environment dictionary. This dictionary
+stores information that describes this implementation as required by the
+Standard. </dd>
+ <dt> <b>void ficlSetEnv(FICL_SYSTEM *pSys, char *name, UNS32 value)</b> </dt>
+ <dd> Enters a new constant into the environment dictionary, with the
+specified name and value. </dd>
+ <dt> <b>void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, UNS32 hi,
+UNS32 lo)</b> </dt>
+ <dd> Enters a new double-cell constant into the environment dictionary
+with the specified name and value. </dd>
+ <dt> <b>FICL_DICT *ficlGetLoc(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Returns a pointer to the locals dictionary. This function is
+defined only if FICL_WANT_LOCALS is #defined as non-zero (see sysdep.h).
+The locals dictionary is the symbol table for <a href="ficl_loc.html">local
+variables</a>. </dd>
+ <dt> <b>void ficlCompileCore(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Defined in words.c, this function builds ficl's primitives.
+ </dd>
+ <dt> <b>void ficlCompileSoftCore(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Defined in softcore.c, this function builds ANS required words
+and ficl extras by evaluating a text string (think of it as a memory
+mapped file ;-) ). The string itself is built from files in
+the softwords directory by PERL script softcore.pl. </dd>
+</dl>
+<hr>
+<table border="0" cellspacing="5" cols="2">
+ <tbody>
+ <tr>
+ <td colspan="2">
+ <h2> <a name="manifest"></a>Ficl Source Files </h2>
+ </td>
+ </tr>
+ <tr>
+ <td> <b>ficl.h</b> </td>
+ <td> Declares most public functions and all data structures.
+Includes sysdep.h and math.h </td>
+ </tr>
+ <tr>
+ <td> <b>sysdep.h</b> </td>
+ <td> Declares system dependent functions and contains build
+control macros. Edit this file to port to another system. </td>
+ </tr>
+ <tr>
+ <td> <b>math.h</b> </td>
+ <td> Declares functions for 64 bit math </td>
+ </tr>
+ <tr>
+ <td> <b>dict.c</b> </td>
+ <td> Dictionary </td>
+ </tr>
+ <tr>
+ <td> <b>ficl.c</b> </td>
+ <td> System initialization, termination, and ficlExec </td>
+ </tr>
+ <tr>
+ <td> <b>float.c</b> </td>
+ <td> Adds precompiled definitions from the optional FLOAT word
+set. Most of the file is conditioned on FICL_WANT_FLOAT </td>
+ </tr>
+ <tr>
+ <td> <b>math64.c</b> </td>
+ <td> Implementation of 64 bit math words (except the two unsigned
+primitives declared in sysdep.h and implemented in sysdep.c) </td>
+ </tr>
+ <tr>
+ <td> <b>prefix.c</b> </td>
+ <td> The optional prefix parse step (conditioned on
+FICL_EXTENDED_PREFIX). This parse step handles numeric constructs like
+0xa100, for example. See the release notes for more on parse steps. </td>
+ </tr>
+ <tr>
+ <td> <b>search.c</b> </td>
+ <td> Contains C implementations of several of the SEARCH and
+SEARCH EXT words </td>
+ </tr>
+ <tr>
+ <td> <b>softcore.c</b> </td>
+ <td> Contains all of the "soft" words - those written in Forth and
+compiled by Ficl at startup time. Sources for these words are in the
+softwords directory. The files softwords/softcore.bat and
+softwords/softcore.pl generate softcore.c from the .fr sources. </td>
+ </tr>
+ <tr>
+ <td> <b>softwords/</b> </td>
+ <td> Directory contains sources and translation scripts for the
+words defined in softcore.c. Softcore.c depends on most of the files in
+this directory. See softcore.bat for the actual list of
+files that contribute to softcore.c. This is where you'll find source
+code for the object oriented extensions. PERL script softcore.pl
+converts the .fr files into softcore.c. </td>
+ </tr>
+ <tr>
+ <td> <b>stack.c</b> </td>
+ <td> Stack methods </td>
+ </tr>
+ <tr>
+ <td> <b>sysdep.c</b> </td>
+ <td> Implementation of system dependent functions declared in
+sysdep.h </td>
+ </tr>
+ <tr>
+ <td> <b>testmain.c</b> </td>
+ <td> The main() function for unix/linux/win32 console applications
+- use this as an example to integrate ficl into your system. Also
+contains some definitions for testing - also useful in
+unix/linux/win32 land. </td>
+ </tr>
+ <tr>
+ <td> <b>tools.c</b> </td>
+ <td> Contains C implementations of TOOLS and TOOLS EXT words, the
+debugger, and debugger support words. </td>
+ </tr>
+ <tr>
+ <td> <b>vm.c</b> </td>
+ <td> Virtual Machine methods </td>
+ </tr>
+ <tr>
+ <td> <b>win32.c & unix.c</b> </td>
+ <td> Platform extensions words loaded in ficl.c by
+ficlCompilePlatform() - conditioned on FICL_WANT_PLATFORM </td>
+ </tr>
+ <tr>
+ <td> <b>words.c</b> </td>
+ <td> Exports ficlCompileCore(), the run-time dictionary builder,
+and contains most precompiled CORE and CORE-EXT words. </td>
+ </tr>
+ </tbody>
+</table>
+<hr>
+<h2> <a name="extras"></a>Ficl extras </h2>
+<h3> <a name="exnumber"></a>Number syntax </h3>
+You can precede a number with "0x", as in C, and it will be interpreted
+as a hex value regardless of the value of <code>BASE</code>. Likewise,
+numbers prefixed with "0d" will be interpreted as decimal values.
+Example:
+<pre>ok> decimal 123 . cr<br>123<br>ok> 0x123 . cr<br>291<br>ok> 0x123 x. cr<br>123<br></pre>
+Note: ficl2.05 and later - this behavior is controlled by the <a
+ href="ficl_parse.html">prefix parser</a> defined in <code>prefix.c</code>.
+You can add other prefixes by defining handlers for them in ficl
+or C.
+<h3> <a name="exsearch"></a> The <code>SEARCH</code> wordset and Ficl
+extensions </h3>
+<p> Ficl implements many of the search order words in terms of two
+primitives called <code><a href="#tosearch">>SEARCH</a></code> and <code><a
+ href="#searchfrom">SEARCH></a></code>. As their names
+suggest (assuming you're familiar with Forth), they push and pop the
+search order stack. </p>
+<p> The standard does not appear to specify any conditions under which
+the search order is reset to a sane state. Ficl resets the search order
+to its default state whenever <tt>ABORT</tt> happens. This includes
+stack underflows and overflows. <tt>QUIT</tt> does not affect the search
+order. The minimum search order (set by <tt>ONLY</tt>) is equivalent
+to </p>
+<pre>FORTH-WORDLIST 1 SET-ORDER<br></pre>
+<p> There is a default maximum of 16 wordlists in the search order. This
+can be changed by redefining FICL_DEFAULT_VOCS (declared in sysdep.h). </p>
+<p> <b>Note</b>: Ficl resets the search order whenever it does <tt>ABORT</tt>.
+If you don't like this behavior, just comment out the
+dictResetSearchOrder() lines in ficlExec(). </p>
+<dl>
+ <dt> <a name="tosearch"></a><code>>search ( wid -- )</code> </dt>
+ <dd> Push <tt>wid</tt> onto the search order. Many of the other search
+order words are written in terms of the <tt>SEARCH></tt> and <tt>>SEARCH</tt>
+primitives. This word can be defined in ANS Forth as follows </dd>
+ <dd> <tt>: >search >r get-order 1+ r> swap
+set-order ;</tt> </dd>
+ <dt> <a name="searchfrom"></a><tt>search> ( -- wid )</tt> </dt>
+ <dd> Pop <tt>wid</tt> off the search order (can be coded in ANS Forth
+as <tt>: search> get-order nip 1- set-order ;</tt> ) </dd>
+ <dt> <a name="ficlsetcurrent"></a><tt>ficl-set-current (
+wid -- old-wid )</tt> </dt>
+ <dd> Set wid as compile wordlist, leaving the previous compile
+wordlist on the stack </dd>
+ <dt> <a name="ficlvocabulary"></a><tt>ficl-vocabulary (
+nBins "name" -- )</tt> </dt>
+ <dd> Creates a <tt>ficl-wordlist</tt> with the specified number of
+hash table bins, binds it to the name, and associates the semantics of <tt>vocabulary</tt>
+with it (replaces the top wid in the search order list with
+its own wid when executed) </dd>
+ <dt> <a name="ficlwordlist"></a><tt>ficl-wordlist ( nBins
+-- wid )</tt> </dt>
+ <dd> Creates a wordlist with the specified number of hash table bins,
+and leaves the address of the wordlist on the stack. A <tt>ficl-wordlist</tt>
+behaves exactly as a regular wordlist, but it may search
+faster depending on the number of bins chosen and the number of words it
+contains at search time. As implemented in ficl, a wordlist is single
+threaded by default. <tt> ficl-named-wordlist</tt> takes a name for the
+wordlist and creates a word that pushes the <tt>wid</tt>. This is by
+contrast to <tt>VOCABULARY</tt>, which also has a name, but replaces
+the top of the search order with its <tt>wid</tt>. </dd>
+ <dt> <a name="ficlforgetwid"></a><tt>forget-wid ( wid -- )</tt> </dt>
+ <dd> Iterates through the specified wordlist and unlinks all
+definitions whose xt addresses are greater than or equal to the value of <tt>HERE</tt>,
+the dictionary fill pointer. </dd>
+ <dt> <a name="ficlhide"></a><tt>hide ( -- current-wid-was
+)</tt> </dt>
+ <dd> Push the <tt>hidden</tt> wordlist onto the search order, and set
+it as the current compile wordlist (unsing <tt>ficl-set-current</tt>).
+Leaves the previous compile wordlist ID. I use this word to
+hide implementation factor words that have low reuse potential so that
+they don't clutter the default wordlist. To undo the effect of hide,
+execute <b><tt>previous set-current</tt></b> </dd>
+ <dt> <a name="ficlhidden"></a><tt>hidden ( -- wid )</tt> </dt>
+ <dd> Wordlist for storing implementation factors of ficl provided
+words. To see what's in there, try: <b><tt>hide words previous
+set-current</tt></b> </dd>
+ <dt> <a name="wid-get-name"></a><tt>wid-get-name ( wid --
+c-addr u )</tt> </dt>
+ <dd> Ficl wordlists (2.05 and later) have a name property that can be
+assigned. This is used by <tt>ORDER</tt> to list the names of wordlists
+in the search order. </dd>
+ <dt> <a name="wid-set-name"></a><tt>wid-set-name ( c-addr
+wid -- )</tt> </dt>
+ <dd> Ficl wordlists (2.05 and later) have a name property that can be
+assigned. This is used by <tt>ORDER</tt> to list the names of wordlists
+in the search order. The name is assumed to be a \0 terminated
+string (C style), which conveniently is how Ficl stores word
+names. See softwords/softcore.fr definition of <tt>brand-wordlist</tt> </dd>
+ <dt> <a name="wid-set-super"></a><tt>wid-set-super ( wid
+-- )</tt> </dt>
+ <dd> Ficl wordlists have a parent wordlist pointer that is not
+specified in standard Forth. Ficl initializes this pointer to NULL
+whenever it creates a wordlist, so it ordinarily has no effect.
+This word sets the parent pointer to the wordlist specified on the top
+of the stack. Ficl's implementation of <tt>SEARCH-WORDLIST</tt> will
+chain backward through the parent link of the wordlist when
+searching. This simplifies Ficl's object model in that the search order
+does not need to reflect an object's class hierarchy when searching for
+a method. It is possible to implement Ficl object syntax in
+strict ANS Forth, but method finders need to manipulate the search order
+explicitly. </dd>
+</dl>
+<h3> <a name="exuser"></a>User variables </h3>
+<dl>
+ <dt> <tt>user ( -- ) name</tt> </dt>
+ <dd> Create a user variable with the given name. User variables are
+virtual machine local. Each VM allocates a fixed amount of storage for
+them. You can change the maximum number of user variables
+allowed by defining FICL_USER_CELLS on your compiiler's command line.
+Default is 16 user cells. User variables behave like <tt>VARIABLE</tt>s
+in all other respects (you use @ and ! on them, for example).
+Example: </dd>
+ <dd>
+ <dl>
+ <dd> <tt>user current-class</tt> </dd>
+ <dd> <tt>0 current-class !</tt> </dd>
+ </dl>
+ </dd>
+</dl>
+<h3> <a name="exmisc"></a>Miscellaneous </h3>
+<dl>
+ <dt> <tt>-roll ( xu xu-1 ... x0 u -- x0 xu-1 ... x1
+) </tt> </dt>
+ <dd> Rotate u+1 items on top of the stack after removing u. Rotation
+is in the opposite sense to <tt>ROLL</tt> </dd>
+</dl>
+<dl>
+ <dt> <a name="minusrot"></a><tt>-rot ( a b c -- c a b )</tt> </dt>
+ <dd> Rotate the top three stack entries, moving the top of stack to
+third place. I like to think of this as <tt>1<sup>1</sup>/<sub>2</sub>swap</tt>
+because it's good for tucking a single cell value behind a
+cell-pair (like an object). </dd>
+</dl>
+<dl>
+ <dt> <tt>.env ( -- )</tt> </dt>
+ <dd> List all environment variables of the system </dd>
+ <dt> <tt>.hash ( -- )</tt> </dt>
+ <dd> List hash table performance statistics of the wordlist that's
+first in the search order </dd>
+ <dt> <tt>.ver ( -- )</tt> </dt>
+ <dd> Display ficl version ID </dd>
+ <dt> <tt>>name ( xt -- c-addr u )</tt> </dt>
+ <dd> Convert a word's execution token into the address and length of
+its name </dd>
+ <dt> <tt>body> ( a-addr -- xt )</tt> </dt>
+ <dd> Reverses the effect of <tt>CORE</tt> word <tt>>body</tt>
+(converts a parameter field address to an execution token) </dd>
+ <dt> <tt>compile-only</tt> </dt>
+ <dd> Mark the most recently defined word as being executable only
+while in compile state. Many <tt>immediate</tt> words have this
+property. </dd>
+ <dt> <tt>empty ( -- )</tt> </dt>
+ <dd> Empty the parameter stack </dd>
+ <dt> <tt>endif</tt> </dt>
+ <dd> Synonym for <tt>THEN</tt> </dd>
+ <dt> <a name="last-word"></a><tt>last-word ( -- xt )</tt> </dt>
+ <dd> Pushes the xt address of the most recently defined word. This
+applies to colon definitions, constants, variables, and words that use <tt>create</tt>.
+You can print the name of the most recently defined word
+with </dd>
+ <dd> <b><tt>last-word >name type</tt> </b> </dd>
+ <dt> <tt>parse-word ( <spaces>name -- c-addr u )</tt> </dt>
+ <dd> 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. (From the Standard) </dd>
+ <dt> <a name="qfetch"></a><tt>q@ ( addr -- x )</tt> </dt>
+ <dd> Fetch a 32 bit quantity from the specified address </dd>
+ <dt> <a name="qbang"></a><tt>q! ( x addr -- )</tt> </dt>
+ <dd> Store a 32 bit quantity to the specified address </dd>
+ <dt> <tt>w@ ( addr -- x )</tt> </dt>
+ <dd> Fetch a 16 bit quantity from the specified address </dd>
+ <dt> <tt>w! ( x addr -- )</tt> </dt>
+ <dd> Store a 16 bit quantity to the specified address (the low 16 bits
+of the given value) </dd>
+ <dt> <a name="xdot"></a><tt>x. ( x -- )</tt> </dt>
+ <dd> Pop and display the value in hex format, regardless of the
+current value of <tt>BASE</tt> </dd>
+</dl>
+<h3> <a name="exficlwin"></a>Extra words defined in testmain.c (Win32
+and POSIX versions) </h3>
+<dl>
+ <dt> <tt>break ( -- )</tt> </dt>
+ <dd> Does nothing - just a handy place to set a debugger breakpoint </dd>
+ <dt> <tt>cd (
+"directory-name<newline>" -- )</tt> </dt>
+ <dd> Executes the Win32 chdir() function, changing the program's
+logged directory. </dd>
+ <dt> <a name="clock"></a><tt>clock ( -- now )</tt> </dt>
+ <dd> Wrapper for the ANSI C clock() function. Returns the number of
+clock ticks elapsed since process start. </dd>
+ <dt> <a name="clockspersec"></a><tt>clocks/sec ( --
+clocks_per_sec )</tt> </dt>
+ <dd> Pushes the number of ticks in a second as returned by <tt>clock</tt> </dd>
+ <dt> <a name="ficlload"></a><tt>load (
+"filename<newline>" -- )</tt> </dt>
+ <dd> Opens the Forth source file specified and loads it one line at a
+time, like <tt>INCLUDED (FILE)</tt> </dd>
+ <dt> <tt>pwd ( -- )</tt> </dt>
+ <dd> Prints the current working directory as set by <tt>cd</tt> </dd>
+ <dt> <tt>system ( "command<newline>" -- )</tt> </dt>
+ <dd> Issues a command to a shell; implemented with the Win32 system()
+call. </dd>
+ <dt> <tt>spewhash ( "filename<newline>" -- )</tt> </dt>
+ <dd> Dumps all threads of the current compilation wordlist to the
+specified text file. This was useful when I thought there might be some
+point in attempting to optimize the hash function. I no longer
+harbor those illusions. </dd>
+</dl>
+<h3> Words defined in FiclWin only </h3>
+<dl>
+ <dt> <tt>!oreg ( c -- )</tt> </dt>
+ <dd> Set the value of the simulated LED register as specified (0..255)
+ </dd>
+ <dt> <tt>@ireg ( -- c )</tt> </dt>
+ <dd> Gets the value of the simulated switch block (0..255) </dd>
+ <dt> <tt>!dac ( c -- )</tt> </dt>
+ <dd> Sets the value of the bargraph control as specified. Valid values
+range from 0..255 </dd>
+ <dt> <tt>@adc ( -- c )</tt> </dt>
+ <dd> Fetches the current position of the slider control. Range is
+0..255 </dd>
+ <dt> <tt>status" ( "ccc<quote>" -- )</tt> </dt>
+ <dd> Set the mainframe window's status line to the text specified, up
+to the first trailing quote character. </dd>
+ <dt> <a name="ficlms"></a><tt><a
+ href="http://www.taygeta.com/forth/dpans10.htm#10.6.2.1905">ms</a>
+( u -- )</tt> </dt>
+ <dd> Causes the running virtual machine to sleep() for the number of
+milliseconds specified by the top-of-stack value. </dd>
+</dl>
+<hr>
+<h2> <a name="ansinfo"></a>ANS Required Information </h2>
+<b>ANS Forth System</b><br>
+<b>Providing names from the Core Extensions word set </b><br>
+<b>Providing the Exception word set</b><br>
+<b>Providing names from the Exception Extensions word set</b><br>
+<b>Providing the Locals word set </b><br>
+<b>Providing the Locals Extensions word set </b><br>
+<b>Providing the Memory Allocation word set</b><br>
+<b>Providing the Programming-Tools word set</b><br>
+<b>Providing names from the Programming-Tools Extensions word set</b><br>
+<b>Providing the Search-Order word set</b><br>
+<b>Providing the Search-Order Extensions word set</b>
+<h3> Implementation-defined Options </h3>
+The implementation-defined items in the following list represent
+characteristics and choices left to the discretion of the implementor,
+provided that the requirements of the Standard are met. A system
+shall document the values for, or behaviors of, each item.
+<ul>
+ <li> <b>aligned address requirements (3.1.3.3 Addresses);</b> </li>
+ <li> <br>
+ <font color="#000000">System dependent. You can change the default
+address alignment by defining FICL_ALIGN on your compiler's command
+line. The default value is set to 2 in sysdep.h. This causes
+dictionary entries and <tt>ALIGN</tt> and <tt>ALIGNED</tt> to align on 4
+byte boundaries. To align on <b>2<sup>n</sup></b> byte boundaries, set
+FICL_ALIGN to <b>n</b>. </font> </li>
+ <li> <b>behavior of 6.1.1320 EMIT for non-graphic characters</b>; </li>
+ <li> <br>
+ <font color="#000000">Depends on target system, C runtime library,
+and your implementation of ficlTextOut().</font> </li>
+ <li> <b>character editing of 6.1.0695 ACCEPT and 6.2.1390 EXPECT</b>; </li>
+ <li> <br>
+ <font color="#000000">None implemented in the versions supplied in
+words.c. Because ficlExec() is supplied a text buffer externally, it's
+up to your system to define how that buffer will be obtained.</font> </li>
+ <li> <b>character set (3.1.2 Character types, 6.1.1320 EMIT, 6.1.1750
+KEY)</b>; </li>
+ <li> <br>
+ <font color="#000000">Depends on target system and implementation
+of ficlTextOut()</font> </li>
+ <li> <b>character-aligned address requirements (3.1.3.3 Addresses)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl characters are one byte each. There are
+no alignment requirements.</font> </li>
+ <li> <b>character-set-extensions matching characteristics (3.4.2
+Finding definition n<font color="#000000">ames)</font></b><font
+ color="#000000">; </font> </li>
+ <li> <br>
+ <font color="#000000">No special processing is performed on
+characters beyond case-folding. Therefore, extended characters will not
+match their unaccented counterparts.</font> </li>
+ <li> <b>conditions under which control characters match a space
+delimiter (3.4.1.1 Delimiters)</b>;<font color="#ff6666"> </font> </li>
+ <li> <br>
+ <font color="#000000">Ficl uses the Standard C function isspace()
+to distinguish space characters. The rest is up to your library vendor.</font> </li>
+ <li> <b>format of the control-flow stack (3.2.3.2 Control-flow stack)</b>; </li>
+ <li> <br>
+ <font color="#000000">Uses the data stack</font> </li>
+ <li> <b>conversion of digits larger than thirty-five (3.2.1.2 Digit
+conversion)</b>; </li>
+ <li> <br>
+ <font color="#000000">The maximum supported value of <tt>BASE</tt>
+is 36. Ficl will assertion fail in function ltoa of vm.c if the base is
+found to be larger than 36 or smaller than 2. There will be no
+effect if NDEBUG is defined</font>, however, other than possibly
+unexpected behavior. </li>
+ <li> <b>display after input terminates in 6.1.0695 ACCEPT and
+6.2.1390 EXPECT</b>; </li>
+ <li> <br>
+ <font color="#000000">Target system dependent</font> </li>
+ <li> <b>exception abort sequence (as in 6.1.0680 ABORT")</b>; </li>
+ <li> <br>
+ <font color="#000000">Does <tt>ABORT</tt></font> </li>
+ <li> <b>input line terminator (3.2.4.1 User input device)</b>;<font
+ color="#ff0000"> </font> </li>
+ <li> <br>
+ <font color="#000000">Target system dependent (implementation of
+outer loop that calls ficlExec)</font> </li>
+ <li> <b>maximum size of a counted string, in characters (3.1.3.4
+Counted strings, 6.1.2450 WORD)</b>; </li>
+ <li> <br>
+ <font color="#000000">255</font> </li>
+ <li> <b>maximum size of a parsed string (3.4.1 Parsing)</b>; </li>
+ <li> <br>
+Limited by available memory and the maximum unsigned value that can fit
+in a CELL (2<sup>32</sup>-1). </li>
+ <li> <b>maximum size of a definition name, in characters (3.3.1.2
+Definition names)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl stores the first 31 characters of a
+definition name.</font> </li>
+ <li> <b>maximum string length for 6.1.1345 ENVIRONMENT?, in characters</b>; </li>
+ <li> <br>
+ <font color="#000000">Same as maximum definition name length</font> </li>
+ <li> <b>method of selecting 3.2.4.1 User input device</b>; </li>
+ <li> <br>
+None supported. This is up to the target system </li>
+ <li> <b>method of selecting 3.2.4.2 User output device</b>; </li>
+ <li> <br>
+None supported. This is up to the target system </li>
+ <li> <b>methods of dictionary compilation (3.3 The Forth dictionary)</b>; </li>
+ <li> <b>number of bits in one address unit (3.1.3.3 Addresses)</b>; </li>
+ <li> <br>
+ <font color="#000000">Target system dependent. Ficl generally
+supports processors that can address 8 bit quantities, but there is no
+dependency that I'm aware of.</font> </li>
+ <li> <b>number representation and arithmetic (3.2.1.1 Internal number
+representation)</b>; </li>
+ <li> <br>
+System dependent. Ficl represents a CELL internally as a union that can
+hold INT32 (a signed 32 bit scalar value), UNS32 (32 bits unsigned), and
+an untyped pointer. No specific byte ordering is
+assumed. </li>
+ <li> <b>ranges for n, +n, u, d, +d, and ud (3.1.3 Single-cell types,
+3.1.4 Cell-pair types)</b>; </li>
+ <li> <br>
+Assuming a 32 bit implementation, range for signed single-cell values
+is -2<sup>31</sup>..2<sup>31</sup>-1. Range for unsigned single cell
+values is 0..2<sup>32</sup>-1. Range for signed double-cell
+values is -2<sup>63</sup>..2<sup>63</sup>-1. Range for unsigned single
+cell values is 0..2<sup>64</sup>-1. </li>
+ <li> <b>read-only data-space regions (3.3.3 Data space)</b>; </li>
+ <li> <br>
+None </li>
+ <li> <b>size of buffer at 6.1.2450 WORD (3.3.3.6 Other transient
+regions)</b>; </li>
+ <li> <br>
+Default is 255. Depends on the setting of nPAD in ficl.h. </li>
+ <li> <b>size of one cell in address units (3.1.3 Single-cell types)</b>; </li>
+ <li> <br>
+ <font color="#000000">System dependent, generally four.</font> </li>
+ <li> <b>size of one character in address units (3.1.2 Character types)</b>; </li>
+ <li> <br>
+ <font color="#000000">System dependent, generally one.</font> </li>
+ <li> <b>size of the keyboard terminal input buffer (3.3.3.5 Input
+buffers)</b>; </li>
+ <li> <br>
+ <font color="#000000">This buffer is supplied by the host program.
+Ficl imposes no practical limit.</font> </li>
+ <li> <b>size of the pictured numeric output string buffer (3.3.3.6
+Other transient regions)</b>; </li>
+ <li> <br>
+Default is 255 characters. Depends on the setting of nPAD in
+ficl.h. </li>
+ <li> <b>size of the scratch area whose address is returned by
+6.2.2000 PAD (3.3.3.6 Other transient regions)</b>; </li>
+ <li> <br>
+Not presently supported </li>
+ <li> <b>system case-sensitivity characteristics (3.4.2 Finding
+definition names)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl is not case sensitive</font> </li>
+ <li> <b>system prompt (3.4 The Forth text interpreter, 6.1.2050 QUIT)</b>; </li>
+ <li> <br>
+ <font color="#000000">"ok>"</font> </li>
+ <li> <b>type of division rounding (3.2.2.1 Integer division, 6.1.0100
+*/, 6.1.0110 */MOD, 6.1.0230 /, 6.1.0240 /MOD, 6.1.1890 MOD)</b>; </li>
+ <li> <br>
+ <font color="#000000">Symmetric</font> </li>
+ <li> <b>values of 6.1.2250 STATE when true</b>; </li>
+ <li> <br>
+ <font color="#000000">One (no others)</font> </li>
+ <li> <b>values returned after arithmetic overflow (3.2.2.2 Other
+integer operations)</b>; </li>
+ <li> <br>
+System dependent. Ficl makes no special checks for overflow. </li>
+ <li> <b>whether the current definition can be found after 6.1.1250
+DOES> (6.1.0450 :)</b>. </li>
+ <li> <br>
+ <font color="#000000">No. Definitions are unsmudged after ; only,
+and only then if no control structure matching problems have been
+detected.</font> </li>
+</ul>
+<h3> Ambiguous Conditions </h3>
+A system shall document the system action taken upon each of the
+general or specific ambiguous conditions identified in this Standard.
+See 3.4.4 Possible actions on an ambiguous condition.
+<p> The following general ambiguous conditions could occur because of a
+combination of factors: </p>
+<ul>
+ <li> <b>a name is neither a valid definition name nor a valid number
+during text interpretation (3.4 The Forth text interpreter)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl does <tt>ABORT</tt> and prints the name
+followed by " not found".</font> </li>
+ <li> <b>a definition name exceeded the maximum length allowed
+(3.3.1.2 Definition names)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl stores the first 31 characters of the
+definition name, and uses all characters of the name in computing its
+hash code. The actual length of the name, up to 255
+characters, is stored in the definition's length field.</font> </li>
+ <li> <b>addressing a region not listed in 3.3.3 Data Space</b>;
+ </li>
+ <li> <br>
+ <font color="#000000">No problem: all addresses in ficl are
+absolute. You can reach any 32 bit address in Ficl's address space.</font> </li>
+ <li> <b>argument type incompatible with specified input parameter,
+e.g., passing a flag to a word expecting an n (3.1 Data types)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl makes no check for argument type
+compatibility. Effects of a mismatch vary widely depending on the
+specific problem and operands.</font> </li>
+ <li> <b>attempting to obtain the execution token, (e.g., with
+6.1.0070 ', 6.1.1550 FIND, etc.) of a definition with undefined
+interpretation semantics</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl returns a valid token, but the result of
+executing that token while interpreting may be undesirable.</font> </li>
+ <li> <b>dividing by zero (6.1.0100 */, 6.1.0110 */MOD, 6.1.0230 /,
+6.1.0240 /MOD, 6.1.1561 FM/MOD, 6.1.1890 MOD, 6.1.2214 SM/REM, 6.1.2370
+UM/MOD, 8.6.1.1820 M*/)</b>; </li>
+ <li> <br>
+ <font color="#000000">Results are target procesor dependent.
+Generally, Ficl makes no check for divide-by-zero. The target processor
+will probably throw an exception.</font> </li>
+ <li> <b>insufficient data-stack space or return-stack space (stack
+overflow)</b>; </li>
+ <li> <br>
+ <font color="#000000">With FICL_ROBUST (sysdep.h) set >= 2, most
+parameter stack operations are checked for underflow and overflow. Ficl
+does not check the return stack.</font> </li>
+ <li> <b>insufficient space for loop-control parameters</b>; </li>
+ <li> <br>
+ <font color="#000000">No check - Evil results.</font> </li>
+ <li> <b>insufficient space in the dictionary</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl generates an error message if the
+dictionary is too full to create a definition header. It checks <tt>ALLOT</tt>
+as well, but it is possible to make an unchecked allocation
+request that overflows the dictionary.</font> </li>
+ <li> <b>interpreting a word with undefined interpretation semantics</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl protects all ANS Forth words with
+undefined interpretation semantics from being executed while in
+interpret state. It is possible to defeat this protection using
+' (tick) and <tt>EXECUTE</tt>, though.</font> </li>
+ <li> <b>modifying the contents of the input buffer or a string
+literal (3.3.3.4 Text-literal regions, 3.3.3.5 Input buffers)</b>; </li>
+ <li> <br>
+ <font color="#000000">Varies depending on the nature of the buffer.
+The input buffer is supplied by ficl's host function, and may reside in
+read-only memory. If so, writing the input buffer can ganerate
+an exception. String literals are stored in the dictionary, and are
+writable.</font> </li>
+ <li> <b>overflow of a pictured numeric output string</b>; </li>
+ <li> <br>
+In the unlikely event you are able to construct a pictured numeric
+string of more than 255 characters, the system will be corrupted
+unpredictably. The buffer area that holds pictured numeric
+output is at the end of the virtual machine. Whatever is mapped after
+the offending VM in memory will be trashed, along with the heap
+structures that contain it. </li>
+ <li> <b>parsed string overflow</b>; </li>
+ <li> <br>
+Ficl does not copy parsed strings unless asked to. Ordinarily, a string
+parsed from the input buffer during normal interpretation is left
+in-place, so there is no possibility of overflow. If you ask
+to parse a string into the dictionary, as in <tt>SLITERAL</tt>, you
+need to have enough room for the string, otherwise bad things may
+happen. This is not usually a problem. </li>
+ <li> <b>producing a result out of range, e.g., multiplication (using
+*) results in a value too big to be represented by a single-cell integer
+(6.1.0090 *, 6.1.0100 */, 6.1.0110 */MOD, 6.1.0570
+>NUMBER, 6.1.1561 FM/MOD, 6.1.2214 SM/REM, 6.1.2370 UM/MOD, 6.2.0970
+CONVERT, 8.6.1.1820 M*/)</b>; </li>
+ <li> <br>
+ <font color="#000000">Value will be truncated</font> </li>
+ <li> <b>reading from an empty data stack or return stack (stack
+underflow)</b>; </li>
+ <li> <br>
+ <font color="#000000">Most stack underflows are detected and
+prevented if FICL_ROBUST (sysdep.h) is set to 2 or greater. Otherwise,
+the stack pointer and size are likely to be trashed.</font> </li>
+ <li> <b>unexpected end of input buffer, resulting in an attempt to
+use a zero-length string as a name</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl returns for a new input buffer until a
+non-empty one is supplied.</font> </li>
+</ul>
+The following specific ambiguous conditions are noted in the glossary
+entries of the relevant words:
+<ul>
+ <li> <b>>IN greater than size of input buffer (3.4.1 Parsing)</b> </li>
+ <li> <br>
+Bad Things occur - unpredictable bacause the input buffer is supplied
+by the host program's outer loop. </li>
+ <li> <b>6.1.2120 RECURSE appears after 6.1.1250 DOES></b> </li>
+ <li> <br>
+It finds the address of the definition before <tt>DOES></tt> </li>
+ <li> <b>argument input source different than current input source for
+6.2.2148 RESTORE-INPUT</b> </li>
+ <li> <br>
+Not implemented </li>
+ <li> <b>data space containing definitions is de-allocated (3.3.3.2
+Contiguous regions)</b> </li>
+ <li> <br>
+This is OK until the cells are overwritten with something else. The
+dictionary maintains a hash table, and the table must be updated in
+order to de-allocate words without corruption. </li>
+ <li> <b>data space read/write with incorrect alignment (3.3.3.1
+Address alignment)</b> </li>
+ <li> <br>
+Target processor dependent. Consequences include: none (Intel), address
+error exception (68K). </li>
+ <li> <b>data-space pointer not properly aligned (6.1.0150 ,, 6.1.0860
+C,)</b> </li>
+ <li> <br>
+See above on data space read/write alignment </li>
+ <li> <b>less than u+2 stack items (6.2.2030 PICK, 6.2.2150 ROLL)</b> </li>
+ <li> <br>
+Ficl detects a stack underflow and reports it, executing <tt>ABORT,</tt>
+as long as FICL_ROBUST is two or larger. </li>
+ <li> <b>loop-control parameters not available ( 6.1.0140 +LOOP,
+6.1.1680 I, 6.1.1730 J, 6.1.1760 LEAVE, 6.1.1800 LOOP, 6.1.2380 UNLOOP)</b> </li>
+ <li> <br>
+Loop initiation words are responsible for checking the stack and
+guaranteeing that the control parameters are pushed. Any underflows will
+be detected early if FICL_ROBUST is set to two or greater.
+Note however that Ficl only checks for return stack underflows at the
+end of each line of text. </li>
+ <li> <b>most recent definition does not have a name (6.1.1710
+IMMEDIATE)</b> </li>
+ <li> <br>
+No problem. </li>
+ <li> <b>name not defined by 6.2.2405 VALUE used by 6.2.2295 TO</b> </li>
+ <li> <br>
+Ficl's version of <tt>TO</tt> works correctly with <tt>VALUE</tt>s, <tt>CONSTANT</tt>s
+and <tt>VARIABLE</tt>s. </li>
+ <li> <b>name not found (6.1.0070 ', 6.1.2033 POSTPONE, 6.1.2510 ['],
+6.2.2530 [COMPILE])</b> </li>
+ <li> <br>
+Ficl prints an error message and does <tt>ABORT</tt> </li>
+ <li> <b>parameters are not of the same type (6.1.1240 DO, 6.2.0620
+?DO, 6.2.2440 WITHIN)</b> </li>
+ <li> <br>
+No check. Results vary depending on the specific problem. </li>
+ <li> <b>6.1.2033 POSTPONE or 6.2.2530 [COMPILE] applied to 6.2.2295 TO</b> </li>
+ <li> <br>
+The word is postponed correctly. </li>
+ <li> <b>string longer than a counted string returned by 6.1.2450 WORD</b> </li>
+ <li> <br>
+Ficl stores the first FICL_STRING_MAX-1 chars in the destination
+buffer. (The extra character is the trailing space required by the
+standard. Yuck.) </li>
+ <li> <b>u greater than or equal to the number of bits in a cell
+(6.1.1805 LSHIFT, 6.1.2162 RSHIFT)</b> </li>
+ <li> <br>
+Depends on target process or and C runtime library implementations of
+the << and >> operators on unsigned values. For I386, the
+processor appears to shift modulo the number of bits in a
+cell. </li>
+ <li> <b>word not defined via 6.1.1000 CREATE (6.1.0550 >BODY,
+6.1.1250 DOES>)</b> </li>
+ <li> <br>
+ <b>words improperly used outside 6.1.0490 <# and 6.1.0040 #>
+(6.1.0030 #, 6.1.0050 #S, 6.1.1670 HOLD, 6.1.2210 SIGN)</b><br>
+Don't. <tt>CREATE</tt> reserves a field in words it builds for <tt>DOES></tt>to
+fill in. If you use <tt>DOES></tt> on a word not made by <tt>CREATE</tt>,
+it will overwrite the first cell of its parameter area.
+That's probably not what you want. Likewise, pictured numeric words
+assume that there is a string under construction in the VM's scratch
+buffer. If that's not the case, results may be unpleasant. </li>
+</ul>
+<h3> Locals Implementation-defined options </h3>
+<ul>
+ <li> <b>maximum number of locals in a definition (13.3.3 Processing
+locals, 13.6.2.1795 LOCALS|)</b> </li>
+ <li> <br>
+Default is 16. Change by redefining FICL_MAX_LOCALS, defined in
+sysdep.h </li>
+</ul>
+<h3> Locals Ambiguous conditions </h3>
+<ul>
+ <li> <b>executing a named local while in interpretation state
+(13.6.1.0086 (LOCAL))</b> </li>
+ <li> <br>
+Locals can be found in interpretation state while in the context of a
+definition under construction. Under these circumstances, locals behave
+correctly. Locals are not visible at all outside the scope of
+a definition. </li>
+ <li> <b>name not defined by VALUE or LOCAL (13.6.1.2295 TO)</b> </li>
+ <li> <br>
+See the CORE ambiguous conditions, above (no change) </li>
+</ul>
+<h3> Programming Tools Implementation-defined options </h3>
+<ul>
+ <li> <b>source and format of display by 15.6.1.2194 SEE</b> </li>
+ <li> <br>
+SEE de-compiles definitions from the dictionary. Because Ficl words are
+threaded by their header addresses, it is very straightforward to print
+the name and other characteristics of words in a definition.
+Primitives are so noted. Colon definitions are decompiled, but branch
+target labels are not reconstructed. Literals and string literals are so
+noted, and their contents displayed. </li>
+</ul>
+<h3> Search Order Implementation-defined options </h3>
+<ul>
+ <li> <b>maximum number of word lists in the search order (16.3.3
+Finding definition names, 16.6.1.2197 SET-ORDER)</b> </li>
+ <li> <br>
+Defaults to 16. Can be changed by redefining FICL_DEFAULT_VOCS,
+declared in sysdep.h </li>
+ <li> <b>minimum search order (16.6.1.2197 SET-ORDER, 16.6.2.1965 ONLY)</b> </li>
+ <li> <br>
+Equivalent to <tt>FORTH-WORDLIST 1 SET-ORDER</tt> </li>
+</ul>
+<h3> Search Order Ambiguous conditions </h3>
+<ul>
+ <li> <b>changing the compilation word list (16.3.3 Finding definition
+names)</b> </li>
+ <li> <br>
+Ficl stores a link to the current definition independently of the
+compile wordlist while it is being defined, and links it into the
+compile wordlist only after the definition completes
+successfully. Changing the compile wordlist mid-definition will cause
+the definition to link into the <i>new</i> compile wordlist. </li>
+ <li> <b>search order empty (16.6.2.2037 PREVIOUS)</b> </li>
+ <li> <br>
+Ficl prints an error message if the search order underflows, and resets
+the order to its default state. </li>
+ <li> <b>too many word lists in search order (16.6.2.0715 ALSO)</b> </li>
+ <li> <br>
+Ficl prints an error message if the search order overflows, and resets
+the order to its default state. </li>
+</ul>
+</div>
+</body>
+</html>
binary files /dev/null b/doc/graphics/4ring.gif differ
binary files /dev/null b/doc/graphics/ficl.4.128.jpg differ
binary files /dev/null b/doc/graphics/ficl.4.64.jpg differ
binary files /dev/null b/doc/graphics/ficl.4.96.jpg differ
binary files /dev/null b/doc/graphics/ficl_oop.jpg differ
binary files /dev/null b/doc/graphics/ficl_top.jpg differ
binary files /dev/null b/doc/graphics/sourceforge.jpg differ
--- /dev/null
+++ b/doc/index.html
@@ -1,0 +1,382 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>ficl</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+ficl
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='WhatisFicl'>
+What is Ficl?
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+
+Ficl is a programming language interpreter designed to be embedded
+into other systems as a command, macro, and development prototyping
+language.
+<p>
+
+Ficl is an acronym for "Forth Inspired Command Language".
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='FiclFeatures'>
+Ficl Features
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+
+<p><dt>
+Ficl is <b><i>easy to port.</i></b>
+<dd>
+
+
+
+<ul>
+
+<li>
+It typically takes under 2 hours to port to a new platform.
+
+<li>
+Ficl is written in strict ANSI C.
+
+<li>
+Ficl can run natively on 32- and 64-bit processors.
+
+</ul>
+
+
+
+<p><dt>
+Ficl has a <b><i>small memory footprint.</i></b>
+<dd>
+
+
+
+A fully featured Win32 console version takes less than 100K
+of memory, and a minimal version is less
+than half that.
+
+
+
+<p><dt>
+Ficl is <b><i>easy to integrate</i></b> into your program.
+<dd>
+
+
+
+Where most Forths 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 your program. 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.
+
+
+
+<p><dt>
+Ficl is <b><i>fast.</i></b>
+<dd>
+
+
+
+Thanks to its
+<a href=http://www.complang.tuwien.ac.at/forth/threaded-code.html#switch-threading>"switch-threaded"</a>
+virtual machine design, Ficl 4 is faster than ever—about 3x the speed of Ficl 3.
+Ficl also features blindingly fast "just in time" compiling, removing the "compile" step from
+the usual compile-debug-edit iterative debugging cycle.
+
+
+
+<p><dt>
+Ficl is a <b><i>complete and powerful programming language.</i></b>
+<dd>
+
+
+
+Ficl is an implementation of the FORTH language, a language providing
+a wide range of standard programming language features:
+<ul>
+
+<li>
+Integer and floating-point numbers, with a rich set of operators.
+
+<li>
+Arrays.
+
+<li>
+File I/O.
+
+<li>
+Flow control (<code>if/then/else</code> and many looping structures).
+
+<li>
+Subroutines with named arguments.
+
+<li>
+Language extensibility.
+
+<li>
+Powerful code pre-processing features.
+
+</ul>
+
+
+
+<p><dt>
+Ficl is <b><i>standards-compliant.</i></b>
+<dd>
+
+
+
+Ficl conforms to the 1994 ANSI Standard for FORTH (DPANS94).
+See <a href=dpans.html>ANS Required Information</a> for
+more detail.
+
+
+<p><dt>
+Ficl is <b><i>extensible.</i></b>
+<dd>
+
+
+
+Ficl is extensible both at compile-time and at run-time.
+You can add new script functions, new native functions,
+even new control structures.
+
+
+
+
+<p><dt>
+Ficl adds <b><i>object oriented programming features.</i></b>
+<dd>
+
+
+
+Ficl's flexible OOP library can be used to wrap
+data structures or classes of the host system without altering them.
+(And remember how we said Ficl was extensible? Ficl's object-oriented
+programming extensions are written in Ficl.)
+
+
+
+<p><dt>
+Ficl is <b><i>interactive.</i></b>
+<dd>
+
+
+
+Ficl can be used interactively, like most other FORTHs, Python,
+and Smalltalk. You can inspect data, run commands, or even
+define new commands, all on a running Ficl VM.
+Ficl also has a built-in script debugger that allows you to
+step through Ficl code as it is executed.
+
+
+<p><dt>
+Ficl is <b><i>ROMable.</i></b>
+<dd>
+
+
+
+Ficl is designed to work in RAM based and ROM code / RAM
+data environments.
+
+
+
+<p><dt>
+Ficl is <b><i>safe for multithreaded programs.</i></b>
+<dd>
+
+
+
+Ficl is reentrant and thread-safe. After initialization,
+it does not write to any global data.
+
+
+<p><dt>
+Ficl is <b><i>open-source and free.</i></b>
+<dd>
+
+
+
+The <a href=license.html>Ficl licence</a> is a BSD-style
+license, requiring only that you document that you are
+using Ficl. There are no licensing costs for using Ficl.
+
+
+</dl>
+
+
+<a name=whatsnew>
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='WhatsNewInFicl40'>
+What's New In Ficl 4.0?
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+</a>
+
+Ficl 4.0 is a major change for Ficl. Ficl 4.0 is <i>smaller</i>,
+<i>faster</i>, <i>more powerful</i>, and <i>easier to use</i>
+than ever before. (Or your money back!)
+<p>
+
+Ficl 4.0 features a major engine rewrite. Previous versions
+of Ficl stored compiled words as an array of pointers to data
+structure; Ficl 4.0 adds "instructions", and changes over to
+mostly using a "switch-threaded" model. The result? Ficl 4.0
+is approximately <i>three times</i> as fast as Ficl 3.03.
+<p>
+
+Ficl 4.0 also adds the ability to store the "softcore" words
+as LZ77 compressed text. Decompression is so quick as to be
+nearly unmeasurable (0.00384 seconds on a 750MHz AMD Duron-based
+machine). And even with the runtime decompressor, the resulting
+Ficl executable is over 13k smaller!
+<p>
+
+Another new feature: Ficl 4.0 can take advantage of native
+support for double-word math. If your platform supports it,
+set the preprocessor symbol <code>FICL_HAVE_NATIVE_2INTEGER</code>
+to 1, and create <code>typedefs</code> for <code>ficl2Integer</code>
+and <code>ficl2Unsigned</code>.
+<p>
+
+Ficl 4.0 also features a retooled API, and a redesigned directory
+tree. The API is now far more consistent. But for those of you
+who are upgrading from Ficl 3.03 or before, you can enable API
+backwards compatibility by turning on the compile-time flag
+<code>FICL_WANT_COMPATIBILITY</code>.
+<p>
+
+Ficl 4.0 also extends support every kind of local and
+global value imaginable. Every values can individually
+be local or global, single-cell or double-cell, and
+integer or floating-point.
+And <code>TO</code> <i>always</i> does the right thing.
+<p>
+
+If you're using Ficl under Windows, you'll be happy
+to know that there's a brand-new build process.
+The Ficl build process now builds Ficl as
+<ul>
+
+<li>
+a static library (.LIB),
+
+<li>
+a dynamic library (.DLL, with a .LIB import library), and
+
+<li>
+a standalone executable (.EXE).
+
+</ul>
+
+Furthermore, each of these targets can be built in
+Debug or Release, Singlethreaded or Multithreaded,
+and optionally using the DLL version of the C runtime
+library for Multithreaded builds. (And, plus, the
+<code>/objects/common</code> nonsense is gone!)
+<p>
+
+
+Finally, Ficl 4.0 adds a <code>contrib</code>
+directory, a repository for user-contributed code that isn't
+part of the standard Ficl release. The only package there
+right now is <b>XClasses</b>, a Python-based IDL that generates
+the definition files for C++-based classes, the equivalent Ficl
+classes, and code to allow the Ficl classes to call the C++ methods.
+Using <b>XClasses</b> you can write your class once, and use it
+immediately from both C++ and Ficl.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='GettingFicl'>
+Getting Ficl
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+You can download Ficl from the
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441>
+Ficl download page at Sourceforge</a>.
+
+
+
+</blockquote><p></td></tr></table></body></html>
+
+
--- /dev/null
+++ b/doc/license.html
@@ -1,0 +1,103 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>ficl licensing</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+ficl licensing
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='FiclLicenseAndDisclaimer'>
+Ficl License And Disclaimer
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<font size=+1>
+Copyright (c) 1997-2001 John Sadler ([email protected])
+<br>
+All rights reserved.
+</font>
+<p>
+
+<b>
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+<ol>
+
+<li>
+Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+<li>
+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.
+
+</ol>
+
+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.
+</b>
+
+
+</blockquote><p></td></tr></table></body></html>
+
+
--- /dev/null
+++ b/doc/links.html
@@ -1,0 +1,318 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>ficl links</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+ficl links
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='OfficialFiclPages'>
+Official Ficl Pages
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<p><dt>
+<a href="http://ficl.sourceforge.net">http://ficl.sourceforge.net</a>
+<dd>
+
+
+The official web home of Ficl.
+
+<p><dt>
+<a href="http://sourceforge.net/project/showfiles.php?group_id=24441">http://sourceforge.net/project/showfiles.php?group_id=24441</a>
+<dd>
+
+
+The Ficl download page.
+
+
+</dl>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='ForthPrimersAndTutorials'>
+Forth Primers And Tutorials
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<p><dt>
+<a href="http://www.phys.virginia.edu/classes/551.jvn.fall01/primer.htm">http://www.phys.virginia.edu/classes/551.jvn.fall01/primer.htm</a>
+<dd>
+
+
+An excellent Forth primer, by Julian Nobel.
+
+<p><dt>
+<a href="http://ficl.sourceforge.net/pdf/Forth_Primer.pdf">http://ficl.sourceforge.net/pdf/Forth_Primer.pdf</a>
+<dd>
+
+
+Another excellent Forth primer, by Hans Bezemer.
+
+<p><dt>
+<a href="http://www.taygeta.com/forth_intro/stackflo.html">http://www.taygeta.com/forth_intro/stackflo.html</a>
+<dd>
+
+
+<i>An Introduction To Forth Using Stack Flow</i> by Gordon Charton.
+Mr. Charton's stack-flow diagrams make it easy to understand how
+to manipulate the FORTH stacks.
+
+<p><dt>
+<a href="http://www.softsynth.com/pforth/pf_tut.htm">http://www.softsynth.com/pforth/pf_tut.htm</a>
+<dd>
+
+
+Phil Burk's Forth Tutorial.
+
+</dl>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='TechnicalArticlesOnFiclAndForth'>
+Technical Articles On Ficl And Forth
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<p><dt>
+<a href="articles/ficlddj.pdf">articles/ficlddj.pdf</a>
+<dd>
+
+
+Manuscript of John Sadler's article on Ficl for January 1999 <a href=http://www.ddj.com>Dr. Dobb's Journal</a>.
+
+<p><dt>
+<a href="articles/jwsforml.pdf">articles/jwsforml.pdf</a>
+<dd>
+
+
+1998 FORML Conference paper: <i>OO Programming in Ficl,</i> written and presented by John Sadler.
+
+
+<p><dt>
+<a href="http://www.complang.tuwien.ac.at/forth/threaded-code.html">http://www.complang.tuwien.ac.at/forth/threaded-code.html</a>
+<dd>
+
+
+Anton Ertl's description of threaded code techniques. (The FORTH-related definition
+of "threaded code" is different from—and predates—the common modern
+usage dealing with light-weight processes.) Ficl 4 uses what Ertl calls
+"switch threading".
+
+<p><dt>
+<a href="http://ficl.sourceforge.net/dpans/dpans.htm">http://ficl.sourceforge.net/dpans/dpans.htm</a>
+<dd>
+
+
+1994 Draft Proposed American National Standard for Forth.
+And surprisingly readable, as language standards go.
+
+<p><dt>
+<a href="http://www.taygeta.com/forthlit.html">http://www.taygeta.com/forthlit.html</a>
+<dd>
+
+
+Forth literature index on Taygeta, a web clearinghouse of Forth links.
+
+</dl>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='OtherForthSitesOfInterest'>
+Other Forth Sites Of Interest
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<p><dt>
+<a href="http://www.forth.org">http://www.forth.org</a>
+<dd>
+
+
+The Forth Interest Group.
+
+<p><dt>
+<a href="http://www.forth.com">http://www.forth.com</a>
+<dd>
+
+
+FORTH, Incorporated. Thirty years old and going strong.
+You might be surprised to learn that they wrote software for
+the <a href=http://www.forth.com/Content/Stories/FedEx.htm>FedEx</a>
+"SuperTracker" bar code scanners / package trackers.
+
+</dl>
+
+<table width=100% bgcolor=#e0e0e0><tr><td width=160>
+<A href="http://t.webring.com/hub?sid=&ring=forth&list"><IMG src="graphics/4ring.gif" width="155" height="140" border="0" alt="Forth Webring Logo"></A>
+</td><td>
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='TheForthWebRing'>
+The Forth Web Ring
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<A href="http://t.webring.com/hub?sid=&ring=forth&id=47&prev5">Previous 5 Sites</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&id=47&prev">Previous</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&id=47&next">Next</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&id=47&next5">Next 5 Sites</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&random">Random Site</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&list">List Sites</A></FONT>
+</td></tr></table>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='SomeSoftwareThatUsesFicl'>
+Some Software That Uses Ficl
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<ul>
+<li>
+The <a href="http://www.freebsd.org/">FreeBSD</a> boot loader
+(Daniel Sobral, Jordan Hubbard)
+
+<li>
+<a href="http://www.chipcenter.com/networking/images/prod/prod158a.pdf">
+SwitchCore
+</a>
+Gigabit Ethernet switches (Örjan Gustavsson )
+
+<li>
+<a href="http://debuffer.sourceforge.net/">
+Palm Pilot Debuffer
+</a>
+(Eric Sessoms)
+Also see <a href=http://sonic-weasel.org/eric/ficlx/>FiclX</a>, a C++ interface to Ficl.
+
+<li>
+<a href="http://www.swcp.com/%7Ejchavez/osmond.html">
+Osmond PC Board Layout tool
+</a>
+
+<li>
+<a href="http://www.netcomsystems.com">
+NetCom Systems
+</a>
+ML7710
+
+<li>
+<a href="http://www.parview.com/ds/homepage.html">
+ParView
+</a>
+GPS system
+
+<li>
+<a href="http://www.thekompany.com/products/powerplant/software/Languages/Embedded.php3">
+PowerPlant Software
+</a>
+Development Environment for Linux
+
+<li>
+<a href="http://www.vyyo.com/products/architecture_v3000.html">
+Vyyo V3000 Broadband Wireless Hub
+</a>
+
+</ul>
+
+(Contact us if you'd like your name and product listed here.)
+
+
+
+</blockquote><p></td></tr></table></body></html>
+
+
--- /dev/null
+++ b/doc/locals.html
@@ -1,0 +1,253 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>local variables in Ficl</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+local variables in Ficl
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='AnOverviewAndAHistory'>
+An Overview And A History
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+
+
+Named, locally scoped variables came late to Forth. Purists feel that experienced
+Forth programmers can (and should) write supportable code using only anonymous
+stack variables and good factoring, and they complain that novices use
+global variables too frequently. But local variables cost little in terms of
+code size and execution speed, and are very convenient for OO programming
+(where stack effects are more complex).
+<p>
+
+Ficl provides excellent support
+for local variables, and the purists be damned—we use 'em all the time.
+<p>
+
+Local variables can only be declared inside a definition,
+and are only visible in that definition. Please refer to
+<a href="http://ficl.sourceforge.net/dpans/dpans13.htm">
+the ANS standard for FORTH
+</a> for more general information on local variables.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='John-HopkinsForthArgumentSyntax'>
+John-Hopkins Forth Argument Syntax
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+ANS Forth does not specify a complete local variable facility.
+Instead, it defines a foundation upon which to build one. Ficl comes with
+an adaptation of the Johns-Hopkins local variable syntax, as developed by John
+Hayes et al. However, Ficl extends this syntax with support for double-cell and
+floating-point numbers.
+
+<p>
+
+Here's the basic syntax of a JH-local variable declaration:
+<blockquote><code>
+<b>{</b> <i>arguments</i>+<b>|</b> <i>locals</i>
+<b>--</b> <i>ignored</i>
+<b>}</b>
+</code></blockquote>
+(For experienced FORTH programmers: the declaration is designed to look like a stack comment,
+but it uses curly braces instead of parentheses.) Each section must list zero or more
+legal Ficl word names; comments and preprocessing are not allowed here.
+Here's what each section denotes:
+
+<ul>
+
+<li>
+The <i>arguments</i> section lists local variables which are initialized from the stack when the word executes.
+Each argument is set to the top value of the stack, starting at the rightmost argument name and moving left.
+You can have zero or more arguments.
+<p>
+
+<li>
+The <i>locals</i> section lists local variables which are set to zero when the word executes.
+You can have zero or more locals.
+<p>
+
+<li>
+Any characters between <code>--</code> and <code>}</code> are treated as a comment, and ignored.
+
+</ul>
+
+(The <code>|</code> and <code>--</code> sections are optional,
+but they must appear in the order shown if they appear at all.)
+<p>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='ArgumentTypes'>
+Argument Types
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+Every time you specify a local variable (in either the <i>arguments</i> or the <i>locals</i> section),
+you can also specify the <i>type</i> of the local variable. By default, a local variable
+is a single-cell integer; you can specify that the local be a double-cell integer, and/or a
+floating-point number.
+<p>
+
+To specify the type of a local, specify one or more of the following single-character specifiers,
+followed by a colon (<code>:</code>).
+
+<table>
+
+<tr><td bgcolor=#e0e0e0>
+<b>1</b>
+</td><td bgcolor=#f0f0f0>
+single-cell
+</td></tr>
+
+
+
+<tr><td bgcolor=#e0e0e0>
+<b>2</b>
+</td><td bgcolor=#f0f0f0>
+double-cell
+</td></tr>
+
+
+
+<tr><td bgcolor=#e0e0e0>
+<b>d</b>
+</td><td bgcolor=#f0f0f0>
+double-cell
+</td></tr>
+
+
+
+<tr><td bgcolor=#e0e0e0>
+<b>f</b>
+</td><td bgcolor=#f0f0f0>
+floating-point (use floating stack)
+</td></tr>
+
+
+
+<tr><td bgcolor=#e0e0e0>
+<b>i</b>
+</td><td bgcolor=#f0f0f0>
+integer (use data stack)
+</td></tr>
+
+
+
+<tr><td bgcolor=#e0e0e0>
+<b>s</b>
+</td><td bgcolor=#f0f0f0>
+single-cell
+</td></tr>
+
+
+
+</table>
+
+For instance, the argument <code>f2:foo</code> would specify a double-width floating-point
+number.
+<p>
+
+The type specifiers are read right-to left, and when two specifiers conflict, the rightmost
+one takes priority. So <code>2is1f2:foo</code> would still specifiy a double-width floating-point
+number.
+<p>
+
+Note that this syntax <i>only works</i> for Ficl's JH-locals. Locals
+defined in some other way (say, with the FORTH standard word <code>LOCALS|</code>)
+will ignore this syntax, and the entire string will be used as the name of
+the local (type and all).
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='ASimpleExample'>
+A Simple Example
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<pre>
+: DEMONSTRATE-JH-LOCALS { c b a f:float -- a+b f:float*2 }+ a b +
+ 2.0e float f*
+ ;
+</pre>
+
+
+</blockquote><p></td></tr></table></body></html>
+
--- /dev/null
+++ b/doc/oop.html
@@ -1,0 +1,1640 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>ficl oop</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+ficl oop
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='FiclObjectOrientedProgramming'>
+Ficl Object Oriented Programming
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+
+Ficl's object extensions provide the traditional OO benefits of associating
+data with the code that manipulates it, and reuse through single inheritance.
+Ficl also has some unusual capabilities that support interoperation with
+systems written in C.
+<p>
+
+Some design points of Ficl's OOP system:
+
+<ul>
+
+<li>
+Ficl objects are normally late bound for safety (late binding guarantees
+that the appropriate method will always be invoked for a particular object).
+Early binding is also available, provided you know the object's class at
+compile-time.
+
+<li>
+Ficl OOP supports single inheritance, aggregation, and arrays of objects.
+
+<li>
+Classes have independent name spaces for their methods: methods are only
+visible in the context of a class or object. Methods can be overridden
+or added in subclasses; there is no fixed limit on the number of methods
+of a class or subclass.
+
+<li>
+Ficl OOP syntax is regular and unified over classes and objects. In ficl,
+all classes are objects. Class methods include the ability to subclass
+and instantiate.
+
+<li>
+Ficl can adapt legacy data structures with object wrappers. You can model
+a structure in a Ficl class, and create an instance that refers to an address
+in memory that holds an instance of the structure. The <i>ref object</i>
+can then manipulate the structure directly. This lets you wrap data structures
+written and instantiated in C.
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='Object-OrientedProgrammingconcepts'>
+Object-Oriented Programming concepts
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+If you're not familiar with object-oriented programming, you
+can click <a href="http://whatis.techtarget.com/definition/0,289893,sid9_gci212681,00.html">here</a>
+or <a href="http://www.softwaredesign.com/objects.html">here</a> for
+a general-purpose overview.
+Or click <a href="articles/oo_in_c.html#review">here</a> for a short review of object-oriented ideas,
+terms, and implementations in C.
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='Acknowledgements'>
+Acknowledgements
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+Ficl is not the first Forth to include Object Oriented extensions. Ficl's
+OO syntax owes a debt to the work of John Hayes and Dick Pountain, among
+others. OO Ficl is different from other OO Forths in a few ways, though
+(some things never change). First, unlike several implementations, the
+syntax is documented (<a href="#ootutorial">below</a>) beyond the source
+code. In Ficl's spirit of working with C code, the OO syntax provides means
+to adapt existing data structures. I've tried to make Ficl's OO model simple
+and safe by unifying classes and objects, providing late binding by default,
+and separating namespaces so that methods and regular Forth words are not
+easily confused.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='FiclObjectModel'>
+Ficl Object Model
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+All classes in Ficl are derived from the common base class
+<code><a href="#objectgloss">OBJECT</a></code>
+as shown in the <a href="#figure1">figure</a> below. All classes are instances
+of <code><a href="#glossclass">METACLASS</a></code>. This means that classes
+are objects, too. <code>METACLASS</code> implements the methods for messages
+sent to classes. Class methods create instances and subclasses, and give
+information about the class. Each class is represented by a data stucture
+of three elements:
+
+<ol>
+
+<li>
+The address (named <code>.CLASS</code> ) of a parent class, or zero if it's
+a base class (only <code>OBJECT</code> and <code>METACLASS</code> have this property).
+
+<li>
+The size (named <code>.SIZE</code> ) in address units of an instance of the
+class.
+
+<li>
+A wordlist ID (named <code>.WID</code> ) for the methods of the class.
+
+</ol>
+
+In the figure below, <code>METACLASS</code> and <code>OBJECT</code> are real system-supplied
+classes. The others are contrived to illustrate the relationships among
+derived classes, instances, and the two system base classes. The dashed
+line with an arrow at the end indicates that the object/class at the arrow
+end is an instance of the class at the other end. The vertical line with
+a triangle denotes inheritance.
+<p>
+
+Note for the curious: <code>METACLASS</code> behaves like a class—it responds
+to class messages and has the same properties as any other class. If you
+want to twist your brain in knots, you can think of <code>METACLASS</code>
+as an instance of itself.
+<p>
+
+
+<a NAME="figure1"></a><img SRC="graphics/ficl_oop.jpg" VSPACE=10 height=442 width=652>
+<br>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='FiclObject-OrientedSyntaxTutorial'>
+Ficl Object-Oriented Syntax Tutorial
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<a NAME="ootutorial"></a>
+
+It's helpful to have some familiarity with Forth and the customary Forth
+stack notation to understand this tutorial. To get started, take a look
+at this <a href="http://www.taygeta.com/forth_intro/stackflo.html">web-based
+Forth tutorial</a>. If you're comfortable with both OO and Forth, you can
+<a href="#ootutorial-finally">jump ahead</a>.
+<p>
+
+A Ficl <a href="oo_in_c.html#object-def">object</a> associates a <a href="oo_in_c.html#class-def">class</a>
+with an <a href="oo_in_c.html#instance-def">instance</a> (the storage for
+one set of instance variables). This is done explicitly on Ficl's stack,
+in that any Ficl object is represented by a cell pair:
+<blockquote><code>( INSTANCE-address CLASS-address )</code></blockquote>
+
+The <code>INSTANCE-address</code> is the address of the object's storage, and the <code>CLASS-address</code>
+is the address of its class. Whenever a named Ficl object executes (e.g.
+when you type its name and press enter at the Ficl prompt), it leaves this
+"signature". All methods by convention expect a class and instance on the
+stack when they execute, too. In many other OO languages, including C++,
+instances contain information about their classes (a <a href="http://www.mvps.org/vbvision/vtable.htm">vtable</a>
+pointer, for example). By making this pairing explicit rather than implicit,
+Ficl can be OO about chunks of data that don't realize that they are objects,
+without sacrificing any robustness for native objects. That means that
+you can use Ficl to write object wrappers for data structures created in
+C or assembly language, as long as you can determine how they're laid out
+in memory.
+<p>
+
+Whenever you create an object in Ficl, you specify its class.
+After that, the object always pushes its class and the address of its
+<a href="http://www.aware.com/Glossary/main.htm#P">payload</a>
+(instance variable space) when invoked by name.
+<p>
+
+Classes are special kinds of objects that store the methods of their
+instances, the size of an instance's payload, and a parent class pointer.
+Classes themselves are instances of a special base class called <code>METACLASS</code>,
+and all classes inherit from class <code>OBJECT</code>. This is confusing at
+first, but it means that Ficl has a very simple syntax for constructing
+and using objects. Class methods include subclassing (<code>SUB</code>), creating
+initialized and uninitialized instances (<code>NEW</code> and <code>INSTANCE</code>),
+and creating reference instances (<code>REF</code>), described later. Classes
+also have methods for disassembling their methods (<code>SEE</code>), identifying
+themselves (<code>ID</code>), and listing their pedigree (<code>PEDIGREE</code>).
+All objects inherit (from <code>OBJECT</code>) methods for initializing instances
+and arrays of instances, for performing array operations, and for getting
+information about themselves.
+
+
+<p>
+</blockquote><table border=0 bgcolor=#d0d0d0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=3><b><i>
+<a name='MethodsAndMessages'>
+Methods And Messages
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+Methods are the functions that objects execute in response to messages.
+A message is a request to an object for a behavior that the object supports.
+When it receives a message, the target object looks up a method that performs
+the behavior for its class, and executes it. Any specific message may be
+bound to different methods in different objects, according to class. This
+separation of messages and methods allows objects to behave <a href="http://www.whatis.com/polymorp.htm">polymorphically</a>.
+(In Ficl, methods are words defined in the context of a class, and messages
+are the names of those words.) Ficl classes associate messages with methods
+for their instances (a fancy way of saying that each class owns a wordlist).
+Ficl provides a late-binding operator <code>--></code> that sends messages
+to objects at run-time, and an early-binding operator <code>=></code>
+that compiles a specific class's method. These operators are the only supported
+way to invoke methods. Regular Forth words are not visible to the method-binding
+operators, so there's no chance of confusing a message with a regular
+word of the same name.
+
+<a NAME="ootutorial-finally"></a>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='Tutorial'>
+Tutorial
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+(Finally!)
+<p>
+
+This is a tutorial. It works best if you follow along by pasting the examples
+into <b>ficlWin</b>, the Win32 version of Ficl included with the release sources
+(or some other build that includes the OO part of <code>softcore.c</code>). If you're
+not familiar with Forth, please see one of these <a href="#links">references</a>.
+Ficl's OOP words are in vocabulary <code>OOP</code>. To put <code>OOP</code> in
+the search order and make it the compilation wordlist, type:
+<pre>
+ONLY
+ALSO OOP DEFINITIONS
+</pre>
+
+<b>Note for beginners:</b> To see the effect of the commands above, type
+<code>ORDER</code>
+after each line. You can repeat the sequence above if you like.
+<p>
+
+To start, we'll work with the two base classes <code>OBJECT</code> and <code>METACLASS</code>.
+Try this:
+<pre>
+METACLASS --> METHODS
+</pre>
+
+The line above contains three words. The first is the name of a class,
+so it pushes its signature on the stack. Since all classes are instances
+of <code>METACLASS</code>, <code>METACLASS</code> behaves as if it is an instance
+of itself (this is the only class with this property). It pushes the same
+address twice: once for the class and once for the payload, since they
+are the same. The next word finds a method in the context of a class and
+executes it. In this case, the name of the method is <code>METHODS</code>.
+Its job is to list all the methods that a class knows. What you get when
+you execute this line is a list of all the class methods Ficl provides.
+<pre>
+OBJECT --> SUB C-LED
+</pre>
+Causes the base-class <code>OBJECT</code> to derive from itself a new class
+called <code>C-LED</code>. Now we'll add some instance variables and methods to the new class.
+<p>
+
+<b>Note:</b> I like to prefix the names of classes with <code>c-</code> and the
+names of member variables with a period, but this is just a convention.
+If you don't like it, pick your own.
+<pre>
+C-BYTE OBJ: .STATE
+: INIT { 2:THIS -- }+ THIS --> SUPER --> INIT
+ ." Initializing an instance of "
+ THIS --> CLASS --> ID TYPE CR ;
+: 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&NBSP; ;
+END-CLASS
+</pre>
+The first line adds an instance variable called <code>.STATE</code> to the
+class. This particular instance variable is an object—it will be an instance
+of <code>C-BYTE</code>, one of Ficl's stock classes (the source for which can be found
+in the distribution in <code>softcore/classes.fr</code>).
+<p>
+
+Next we've defined a method called <code>INIT</code>. This line also declares
+a <a href="locals.html">local variable</a> called <code>THIS</code>
+(the 2 in front tells Ficl that this is a double-cell local). All methods
+by convention expect the address of the class and instance on top of the
+stack when called. The next three lines define the behavior of <code>INIT</code> when it's called.
+It first calls its superclass's version of <code>INIT</code> (which in this
+case is "<code>OBJECT => INIT</code>"—this default implementation clears all
+instance variables). The rest displays some text and causes the instance
+to print its class name (<code>THIS --> CLASS --> ID</code>).
+<p>
+
+The <code>INIT</code>> method is special for Ficl objects: whenever
+you create an initialized instance using <code>NEW</code> or <code>NEW-ARRAY</code>,
+Ficl calls the class's <code>INIT</code> method for you on that instance. The
+default <code>INIT</code> method supplied by <code>OBJECT</code> clears the instance,
+so we didn't really need to override it in this case (see the source code
+in <code>softcore/oo.fr</code>).
+<p>
+
+The <code>ON</code> and <code>OFF</code> methods defined above hide the details
+of turning LEDs on and off. The interface to FiclWin's simulated hardware
+is handled by <code>!OREG</code>. The class keeps the LED state in a shadow
+variable (<code>.STATE</code>) so that <code>ON</code> and <code>OFF</code> can work
+in terms of LED number rather than a bitmask.
+<p>
+
+Now make an instance of the new class:
+<pre>
+C-LED --> NEW LED
+</pre>
+
+And try a few things...
+<pre>
+LED --> METHODS
+LED --> PEDIGREE
+1 LED --> ON
+1 LED --> OFF
+</pre>
+
+Or you could type this with the same effect:
+<pre>
+LED 2DUP --> METHODS --> PEDIGREE
+</pre>
+
+Notice (from the output of <code>METHODS</code>) that we've overridden the
+<code>INIT</code> method supplied by object, and added two more methods for the member
+variables. If you type <code>WORDS</code>, you'll see that these methods are
+not visible outside the context of the class that contains them. The method
+finder <code>--></code> uses the class to look up methods. You can use
+this word in a definition, as we did in <code>INIT</code>, and it performs
+late binding, meaning that the mapping from message (method name) to method
+(the code) is deferred until run-time. To see this, you can decompile the
+init method like this:
+<pre>
+C-LED --> SEE INIT
+</pre>
+
+or
+<pre>
+LED --> CLASS --> SEE INIT
+</pre>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='EarlyBinding'>
+Early Binding
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+Ficl also provides early binding if you ask for it. Early binding is not
+as safe as late binding, but it produces code that is more compact and
+efficient because it compiles method addresses rather then their names.
+In the preferred uses of early binding, the class is assumed to be the
+one you're defining. This kind of early binding can only be used inside
+a class definition. Early bound methods still expect to find a class and
+instance cell-pair on top of the stack when they run.
+<p>
+
+Here's an example that illustrates a potential problem:
+<pre>
+OBJECT --> SUB C1
+: M1 { 2:THIS -- } ." C1'S M1" CR ;+: M2 { 2:THIS -- } ." Running " THIS MY=> M1 ; ( early )+: M3 { 2:THIS -- } ." Running " THIS --> M1 ( late )+END-CLASS
+C1 --> SUB C2
+: M1 { 2:THIS -- } ." C2'S M1" CR ;+END-CLASS
+C2 --> NEW I2
+I2 --> M1 ( runs the M1 defined in C2 )
+I2 --> M2 ( Is this what you wanted? )
+I2 --> M3 { runs the overridden M1)+</pre>
+
+Even though we overrode method <code>M1</code> in class <code>C2</code>, the definition of <code>M2</code> with
+early binding forced the use of <code>M1</code> as defined in <code>C1</code>. If that's what you
+want, great, but more often you'll want the flexibility of overriding parent
+class behaviors appropriately.
+
+<ol>
+
+<li>
+<code>MY=></code> binds early to a method in the class being defined,
+as in the example above.
+
+<li>
+<code>MY=[ ]</code> binds a sequence of methods in the current class.
+Useful when the class has object members. Lines like
+<code>THIS --> STATE --> SET</code> in the definition of <code>C-LED</code> above can be replaced with
+<code>THIS MY=[ STATE SET ]</code> to use early binding.
+
+<li>
+<code>=></code> (dangerous) pops a class off the stack and compiles
+the method in that class. Since you have to specify the class explicitly,
+there is a real danger that this will be out of sync with the class you
+really wanted. I recommend you use <code>MY=></code> or <code>MY=[ ]</code> instead.
+
+</ol>
+
+Early binding using <code>=></code> is dangerous because it partially
+defeats the data-to-code matching mechanism object oriented languages were
+created to provide, but it does increase run-time speed by binding the
+method at compile time. In many cases, such as the <code>INIT</code> method,
+you can be reasonably certain of the class of thing you're working on.
+This is also true when invoking class methods, since all classes are instances
+of <code>METACLASS</code>. Here's an example from the definition of <code>METACLASS</code>
+in oo.fr (don't paste this into ficlWin—it's already there):
+<pre>
+: NEW \ ( class metaclass "name" -- )
+ METACLASS => INSTANCE --> INIT ;
+</pre>
+
+Try this:
+<pre>
+METACLASS --> SEE NEW
+</pre>
+
+Decompiling the method with <code>SEE</code> shows the difference between the
+two strategies. The early bound method is compiled inline, while the late-binding
+operator compiles the method name and code to find and execute it in the
+context of whatever class is supplied on the stack at run-time.
+<p>
+
+Notice that the primitive early-binding operator <code>=></code> requires
+a class at compile time. For this reason, classes are <code>IMMEDIATE</code>,
+meaning that they push their signature at compile time or run time. I'd
+recommend that you avoid early binding until you're very comfortable with
+Forth, object-oriented programming, and Ficl's OOP syntax.
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='MoreAboutInstanceVariables'>
+More About Instance Variables
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<i>Untyped</i> instance variable methods (created by <code>CELL: CELLS: CHAR:</code>
+and <code>CHARS:</code>) just push the address of the corresponding instance
+variable when invoked on an instance of the class. It's up to you to remember
+the size of the instance variable and manipulate it with the usual Forth
+words for fetching and storing.
+<p>
+
+As advertised earlier, Ficl provides ways to objectify existing data
+structures without changing them. Instead, you can create a Ficl class
+that models the structure, and instantiate a <i>ref</i> from this class,
+supplying the address of the structure. After that, the <i>ref instance</i>
+behaves as a Ficl object, but its instance variables take on the values
+in the existing structure. Example (from <code>softcore/ficlclass.fr</code>):
+<pre>
+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
+</pre>
+
+In this case, <code>C-WORDLIST</code> describes Ficl's wordlist structure;
+<code>NAMED-WID</code> creates a wordlist and binds it to a ref instance of
+<code>C-WORDLIST</code>.
+The fancy footwork with <code>POSTPONE</code> and early binding is required
+because classes are immediate. An equivalent way to define <code>NAMED-WID</code> with
+late binding is:
+<pre>
+: NAMED-WID ( c-address u -- )
+ WORDLIST POSTPONE C-WORDLIST --> REF
+ ;
+</pre>
+
+To do the same thing at run-time (and call it <code>MY-WORDLIST</code>):
+
+<pre>wordlist c-wordlist --> ref my-wordlist</pre>
+
+Now you can deal with the wordlist through the ref instance:
+<pre>
+MY-WORDLIST --> PUSH
+MY-WORDLIST --> SET-CURRENT
+ORDER
+</pre>
+
+Ficl can also model linked lists and other structures that contain pointers
+to structures of the same or different types. The class constructor word
+<a href="#exampleref:"><code>REF:</code></a>
+makes an aggregate reference to a particular class. See the <a href="#glossinstance">instance
+variable glossary</a> for an <a href="#exampleref:">example</a>.
+<p>
+
+Ficl can make arrays of instances, and aggregate arrays into class descripions.
+The <a href="#glossclass">class methods</a> <code>ARRAY</code> and <code>NEW-ARRAY</code>
+create uninitialized and initialized arrays, respectively, of a class.
+In order to initialize an array, the class must define (or inherit) a reasonable
+<code>INIT</code> method. <code>NEW-ARRAY</code> invokes it on each member of the array
+in sequence from lowest to highest. Array instances and array members use
+the object methods <code>INDEX</CODE>, <CODE>NEXT</CODE>, and <CODE>PREV</code>
+to navigate. Aggregate a member array of objects using <a href="#arraycolon"><code>ARRAY:</code></a>.
+The objects are not automatically initialized in this case—your class
+initializer has to call <code>ARRAY-INIT</code> explicitly if you want
+this behavior.
+<p>
+
+For further examples of OOP in Ficl, please see the source file <code>softcore/ficlclass.fr</code>.
+This file wraps several Ficl internal data structures in objects and gives
+use examples.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='FiclStringClasses'>
+Ficl String Classes
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<a NAME="cstring"></a>
+
+<code>C-STRING</code> is a reasonably useful dynamic string class.
+Source code for the class is located in <code>softcore/string.fr</code>.
+Features:
+dynamic creation and resizing; deletion, char cout, concatenation, output,
+comparison; creation from quoted string constant (<code>S"</code>).
+<p>
+Examples of use:
+<pre>
+C-STRING --> NEW HOMER
+S" In this house, " HOMER --> SET
+S" we obey the laws of thermodynamics!" HOMER --> CAT
+HOMER --> TYPE
+</pre>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='OOPGlossary'>
+OOP Glossary
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<a NAME="oopgloss"></a>
+
+<b>Note:</b> With the exception of the binding operators (the first two definitions
+here), all of the words in this section are internal factors that you don't
+need to worry about. These words provide method binding for all classes
+and instances. Also described are supporting words and execution factors.
+All are defined in <code>softcore/oo.fr</code>.
+
+<dl>
+
+<dt><code>--> <i>( instance class "method-name" -- xn )</i></code><dd>
+
+
+
+Late binding: looks up and executes the given method in the context of
+the class on top of the stack.
+
+<dt><code>C-> <i>( instance class "method-name" -- xn exc )</i></code><dd>
+
+
+
+Late binding with <code>CATCH</code>: looks up and <code>CATCH</code>es the given
+method in the context of the class on top of the stack, pushes zero or
+exception code upon return.
+
+<dt><code>MY=> <i>compilation: ( "method-name" -- ) execution: ( instance class -- xn )</i></code><dd>
+
+
+
+Early binding: compiles code to execute the method of the class being defined.
+Only visible and valid in the scope of a <code>--> SUB</CODE> .. <CODE>END-CLASS</code>
+class definition.
+
+<dt><code>MY=[ <i>compilation: ( "obj1 obj2 .. method ]" -- ) execution: ( instance class -- xn )</i></code><dd>
+
+
+
+Early binding: compiles code to execute a chain of methods of the class
+being defined. Only visible and valid in the scope of a <code>--> SUB</CODE>
+.. <CODE>END-CLASS</code> class definition.
+
+<dt><code>=> <i>compilation: ( class metaclass "method-name" -- ) execution: ( instance class -- xn )</i></code><dd>
+
+
+
+Early binding: compiles code to execute the method of the class specified
+at compile time.
+
+<dt><code>do-do-instance <i></i></code><dd>
+
+
+
+When executed, causes the instance to push its <code>( INSTANCE CLASS )</code> stack
+signature. Implementation factor of <code>METACLASS --> SUB</code></b> .
+Compiles <code>.DO-INSTANCE</code> in the context of a class; <code>.DO-INSTANCE</code>
+implements the <code>DOES></code> part of a named instance.
+
+<dt><code>exec-method <i>( instance class c-address u -- xn )</i></code><dd>
+
+
+
+Given the address and length of a method name on the stack, finds
+the method in the context of the specified class and invokes it. Upon entry
+to the method, the instance and class are on top of the stack, as usual.
+If unable to find the method, prints an error message and aborts.
+
+<dt><code>find-method-xt <i>( class "method-name" -- class xt )</i></code><dd>
+
+
+
+Attempts to map the message to a method in the specified class. If successful,
+leaves the class and the execution token of the method on the stack. Otherwise
+prints an error message and aborts.
+
+<dt><code>lookup-method <i>( class c-address u -- class xt )</i></code><dd>
+
+
+
+Given the address and length of a method name on the stack, finds
+the method in the context of the specified class. If unable to find the
+method, prints an error message and aborts.
+
+<dt><code>parse-method <i>compilation: ( "method-name" -- ) execution: ( -- c-address u )</i></code><dd>
+
+
+
+Parse <code>"method-name"</code> from the input stream and compile code to push its length
+and address when the enclosing definition runs.
+</dl>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#d0d0d0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=3><b><i>
+<a name='InstanceVariableGlossary'>
+Instance Variable Glossary
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<a NAME="glossinstance"></a>
+
+<b>Note:</b>: These words are only visible when creating a subclass! To
+create a subclass, use the <code>SUB</code> method on <code>OBJECT</code> or any
+class derived from it (<i>not</i> <code>METACLASS</code>). Source code for
+Ficl OOP is in <code>softcore/oo.fr</code>.
+<p>
+
+Instance variable words do two things: they create methods that do
+san action appropriate for the type of instance variable they represent,
+and they reserve space in the class template for the instance variable.
+We'll use the term <i>instance variable</i> to refer both to the method
+that gives access to a particular field of an object, and to the field
+itself. Rather than give esentially the same example over and over, here's
+one example that shows several of the instance variable construction words
+in use:
+
+<pre>
+OBJECT SUBCLASS C-EXAMPLE
+ CELL: .CELL0
+ C-4BYTE OBJ: .NCELLS
+ 4 C-4BYTE ARRAY: .QUAD
+ CHAR: .LENGTH
+ 79 CHARS: .NAME
+END-CLASS
+</pre>
+
+This class only defines instance variables, and it inherits some methods
+from <code>OBJECT</code>. Each untyped instance variable (<code>.CELL0</code>, <code>.LENGTH</code>,
+<code>.NAME</code>) pushes its address when executed. Each object instance variable
+pushes the address and class of the aggregate object. Similar to C, an
+array instance variable leaves its base address (and its class) when executed.
+The word <code>SUBCLASS</code> is shorthand for <code>--> sub</code> .
+
+<dl>
+
+<dt><code>CELL: <i>compilation: ( offset "name" -- offset ) execution: ( -- cell-address )</i></code><dd>
+
+
+
+Create an untyped instance variable one cell wide. The instance variable
+leaves its payload's address when executed.
+
+<dt><code>CELLS: <i>compilation: ( offset nCells "name" -- offset' ) execution: ( -- cell-address )</i></code><dd>
+
+
+
+Create an untyped instance variable <code>nCells</code> cells wide.
+
+<dt><code>CHAR: <i>compilation: ( offset "name" -- offset' ) execution: ( -- cell-address )</i></code><dd>
+
+
+
+Create an untyped member variable one character wide.
+
+<dt><code>CHARS: <i>compilation: ( offset nChars "name" -- offset' ) execution: ( -- cell-address )</i></code><dd>
+
+
+
+Create an untyped member variable <code>nChars</code> characters wide.
+
+<dt><code>OBJ: <i>compilation: ( offset class metaclass "name" -- offset' ) execution: ( -- instance class )</i></code><dd>
+
+
+
+Aggregate an uninitialized instance of <code>CLASS</code> as a member variable
+of the class under construction.
+
+<dt><code>ARRAY: <i>compilation: ( offset nObjects class metaclass "name" -- offset' ) execution: ( -- instance class )</i></code><dd>
+
+
+<a NAME="arraycolon"></a>
+
+Aggregate an uninitialized array of instances of the class specified as
+a member variable of the class under construction.
+
+<dt><code>EXAMPLEREF: <i>compilation: ( offset class metaclass "name" -- offset' ) execution: ( -- ref-instance ref-class )</i></code><dd>
+
+
+
+Aggregate a reference to a class instance. There is no way to set the value
+of an aggregated ref—it's meant as a way to manipulate existing data
+structures with a Ficl OO model. For example, if your system contains a
+linked list of 4 byte quantities, you can make a class that represents
+a list element like this:
+
+<pre>
+OBJECT SUBCLASS C-4LIST
+ C-4LIST REF: .LINK
+ C-4BYTE OBJ: .PAYLOAD
+END-CLASS
+
+ADDRESS-OF-EXISTING-LIST C-4LIST --> REF MYLIST
+</pre>
+
+<dd>
+The last line binds the existing structure to an instance of the class
+we just created. The link method pushes the link value and the class <code>C_4LIST</code>,
+so that the link looks like an object to Ficl and like a struct to C (it
+doesn't carry any extra baggage for the object model—the Ficl methods
+alone take care of storing the class information).
+<p>
+
+<b>Note:</b> Since a <code>REF:</code> aggregate can only support one class, it's good for
+modeling static structures, but not appropriate for polymorphism. If you
+want polymorphism, aggregate a <code>C_REF</code> (see <code>softcore/classes.fr</code> for source)
+into your class—it has methods to set and get an object.
+<p>
+
+By the way, it is also possible to construct a pair of classes that contain
+aggregate pointers to each other. Here's an example:
+
+<pre>
+OBJECT SUBCLASS AKBAR
+ SUSPEND-CLASS \ put akbar on hold while we define jeff
+
+OBJECT SUBCLASS JEFF
+ AKBAR REF: .SIGNIFICANT-OTHER
+ ( <i>... your additional methods here ...</i> )
+END-CLASS \ done with jeff
+
+AKBAR --> RESUME-CLASS \ resume defining akbar
+ JEFF REF: .SIGNIFICANT-OTHER
+ ( <i>... your additional methods here ...</i> )
+END-CLASS \ done with akbar
+</pre>
+
+</dl>
+
+<a NAME="glossclass"></a>
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='ClassMethodsGlossary'>
+Class Methods Glossary
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+These words are methods of <code>METACLASS</code>. They define the manipulations
+that can be performed on classes. Methods include various kinds of instantiation,
+programming tools, and access to member variables of classes. Source is
+in <code>softcore/oo.fr</code>.
+
+<dl>
+
+<dt><code>INSTANCE <i>( class metaclass "name" -- instance class )</i></code><dd>
+
+
+
+Create an uninitialized instance of the class, giving it the name specified.
+The method leaves the instance's signature on the stack (handy if you
+want to initialize). Example:
+
+<pre>
+C_REF --> INSTANCE UNINIT-REF 2DROP
+</pre>
+
+<dt><code>NEW <i>( class metaclass "name" -- )</i></code><dd>
+
+
+
+Create an initialized instance of class, giving it the name specified.
+This method calls <code>INIT</code> to perform initialization.
+
+<dt><code>ARRAY <i>( nObjects class metaclass "name" -- nObjects instance class )</i></code><dd>
+
+
+
+Create an array of <code>nObjects</code> instances of the specified class.
+Instances are not initialized. Example:
+
+<pre>
+10 C_4BYTE --> ARRAY 40-RAW-BYTES 2DROP DROP
+</pre>
+
+
+<dt><code>NEW-ARRAY <i>( nObjects class metaclass "name" -- )</i></code><dd>
+
+
+
+Creates an initialized array of <code>nObjects</code> instances of the class.
+Same syntax as <code>ARRAY</code>.
+
+<a NAME="alloc"></a>
+<dt><code>ALLOC <i>( class metaclass -- instance class )</i></code><dd>
+
+
+
+Creates an anonymous instance of <code>CLASS</code> from the heap (using a call
+to <code>ficlMalloc()</code> to get the memory). Leaves the payload and class addresses
+on the stack. Usage example:
+
+<pre>
+C-REF --> ALLOC 2CONSTANT INSTANCE-OF-REF
+</pre>
+<p>
+
+Creates a double-cell constant that pushes the payload and class address
+of a heap instance of <code>C-REF</code>.
+
+<a NAME="allocarray"></a>
+<dt><code>ALLOC-ARRAY <i>( nObjects class metaclass -- instance class )</i></code><dd>
+
+
+
+Same as <code>NEW-ARRAY</code>, but creates anonymous instances from the heap using
+a call to <code>ficlMalloc()</code>. Each instance is initialized using the class's
+<code>INIT</code> method.
+
+<a NAME="allot"></a>
+<dt><code>ALLOT <i>( class metaclass -- instance class )</i></code><dd>
+
+
+
+Creates an anonymous instance of <code>CLASS</code> from the dictionary. Leaves
+the payload and class addresses on the stack. Usage example:
+
+<pre>
+C-REF --> ALLOT 2CONSTANT INSTANCE-OF-REF
+</pre>
+
+<p>
+
+Creates a double-cell constant that pushes the payload and class address
+of a heap instance of <code>C-REF</code>.
+
+<a NAME="allotarray"></a>
+<dt><code>ALLOT-ARRAY <i>( nObjects class metaclass -- instance class )</i></code><dd>
+
+
+
+Same as <code>NEW-ARRAY</code>, but creates anonymous instances from the dictionary.
+Each instance is initialized using the class's <code>INIT</code> method.
+
+<dt><code>REF <i>( instance-address class metaclass "name" -- )</i></code><dd>
+
+
+
+Make a ref instance of the class that points to the supplied instance address.
+No new instance space is allotted. Instead, the instance refers to the
+address supplied on the stack forever afterward. For wrapping existing
+structures.
+
+
+<dt><code>SUB <i>( class metaclass -- old-wid address[size] size )</i></code><dd>
+
+
+
+Derive a subclass. You can add or override methods, and add instance variables.
+Alias: <code>SUBCLASS</code>. Examples:
+<p>
+
+<pre>
+C_4BYTE --> SUB C_SPECIAL4BYTE
+ ( <i>... your new methods and instance variables here ...</i> )
+END-CLASS
+</pre>
+
+or
+
+<pre>
+C_4BYTE SUBCLASS C_SPECIAL4BYTE
+ ( <i>... your new methods and instance variables here ...</i> )
+END-CLASS
+</pre>
+
+<dt><code>.SIZE <i>( class metaclass -- instance-size )</i></code><dd>
+
+
+
+Returns address of the class's instance size field, in address units. This
+is a metaclass member variable.
+
+<dt><code>.SUPER <i>( class metaclass -- superclass )</i></code><dd>
+
+
+
+Returns address of the class's superclass field. This is a metaclass member
+variable.
+
+<dt><code>.WID <i>( class metaclass -- wid )</i></code><dd>
+
+
+
+Returns the address of the class's wordlist ID field. This is a metaclass
+member variable.
+
+<dt><code>GET-SIZE <i>( -- instance-size )</i></code><dd>
+
+
+
+Returns the size of an instance of the class in address units. Imeplemented
+as follows:
+
+<pre>
+: GET-SIZE METACLASS => .SIZE @ ;
+</pre>
+
+<dt><code>GET-WID <i>( -- wid )</i></code><dd>
+
+
+
+Returns the wordlist ID of the class. Implemented as:
+
+<pre>
+: GET-WID METACLASS => .WID @ ;
+</pre>
+
+<dt><code>GET-SUPER <i>( -- superclass )</i></code><dd>
+
+
+
+Returns the class's superclass. Implemented as
+
+<pre>
+: GET-SUPER METACLASS => .super @ ;
+</pre>
+
+
+<dt><code>ID <i>( class metaclass -- c-address u )</i></code><dd>
+
+
+
+Returns the address and length of a string that names the class.
+
+
+<dt><code>METHODS <i>( class metaclass -- )</i></code><dd>
+
+
+
+Lists methods of the class and all its superclasses.
+
+
+<dt><code>OFFSET-OF <i>( class metaclass "name" -- offset )</i></code><dd>
+
+
+
+Pushes the offset from the instance base address of the named member variable.
+If the name is not that of an instance variable method, you get garbage.
+There is presently no way to detect this error. Example:
+
+<pre>
+metaclass --> offset-of .wid
+</pre>
+
+
+<dt><code>PEDIGREE <i>( class metaclass -- )</i></code><dd>
+
+
+
+
+Lists the pedigree of the class (inheritance trail).
+
+<dt><code>SEE <i>( class metaclass "name" -- )</i></code><dd>
+
+
+
+Decompiles the specified method—obect version of <code>SEE</code>, from the
+<code>TOOLS</code> wordset.
+
+</dl>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='codeOBJECT/codeBase-ClassMethodsGlossary'>
+<code>OBJECT</code> Base-Class Methods Glossary
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<a NAME="objectgloss"></a>
+
+These are methods that are defined for all instances by the base class
+<code>OBJECT</code>.
+The methods include default initialization, array manipulations, aliases
+of class methods, upcasting, and programming tools.
+
+<dl>
+
+<dt><code>INIT <i>( instance class -- )</i></code><dd>
+
+
+
+Default initializer, called automatically for all instances created with
+<code>NEW</code>
+or <code>NEW-ARRAY</code>. Zero-fills the instance. You do not normally need
+to invoke <code>INIT</code> explicitly.
+
+<dt><code>ARRAYINIT <i>( nObjects instance class -- )</i></code><dd>
+
+
+
+Applies <code>INIT</code> to an array of objects created by <code>NEW-ARRAY</code>.
+Note that <code>ARRAY:</code> does not cause aggregate arrays to be initialized
+automatically. You do not normally need to invoke <code>ARRAY-INIT</code> explicitly.
+
+<dt><code>FREE <i>( instance class -- )</i></code><dd>
+
+
+
+Releases memory used by an instance previously created with <code>ALLOC</code>
+or <code>ALLOC-ARRAY</code>. <b>Note:</b> This method is not presently protected
+against accidentally deleting something from the dictionary. If you do
+this, Bad Things are likely to happen. Be careful for the moment to apply
+free only to instances created with <code>ALLOC</code> or <code>ALLOC-ARRAY</code>.
+
+<dt><code>CLASS <i>( instance class -- class metaclass )</i></code><dd>
+
+
+
+Convert an object signature into that of its class. Useful for calling
+class methods that have no object aliases.
+
+<dt><code>SUPER <i>( instance class -- instance superclass )</i></code><dd>
+
+
+
+Upcast an object to its parent class. The parent class of <code>OBJECT</code>
+is zero. Useful for invoking an overridden parent class method.
+
+<dt><code>PEDIGREE <i>( instance class -- )</i></code><dd>
+
+
+
+Display an object's pedigree—its chain of inheritance. This is an alias
+for the corresponding class method.
+
+<dt><code>SIZE <i>( instance class -- instance-size )</i></code><dd>
+
+
+
+Returns the size, in address units, of one instance. Does not know about
+arrays! This is an alias for the class method <code>GET-SIZE</code>.
+
+<dt><code>METHODS <i>( instance class -- )</i></code><dd>
+
+
+
+Class method alias. Displays the list of methods of the class and all superclasses
+of the instance.
+
+<dt><code>INDEX <i>( n instance class -- instance[n] class )</i></code><dd>
+
+
+
+Convert array-of-objects base signature into signature for array element
+n. No check for bounds overflow. Index is zero-based, like C, so
+
+<pre>
+0 MY-OBJ --> INDEX
+</pre>
+
+is equivalent to
+
+<pre>
+MY-OBJ
+</pre>
+
+Check out the <a href="#minusrot">description of <code>-ROT</code></a> for
+help in dealing with indices on the stack.
+
+<dt><code>NEXT <i>( instance[n] class -- instance[n+1] )</i></code><dd>
+
+
+
+Convert an array-object signature into the signature of the next
+object in the array. No check for bounds overflow.
+
+<dt><code>PREV <i>( instance[n] class -- instance[n-1] class )</i></code><dd>
+
+
+
+Convert an object signature into the signature of the previous object
+in the array. No check for bounds underflow.
+
+</dl>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='SuppliedClasses'>
+Supplied Classes
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<a NAME="stockclasses"></a>
+
+For more information on theses classes, see <code>softcore/classes.fr</code>.
+
+<dl>
+
+<dt><code>METACLASS <i></i></code><dd>
+
+
+
+Describes all classes of Ficl. Contains class methods. Should never be
+directly instantiated or subclassed. Defined in <code>softcore/oo.fr</code>. Methods described
+above.
+
+<dt><code>OBJECT <i></i></code><dd>
+
+
+
+Mother of all Ficl objects. Defines default initialization and array indexing
+methods. Defined in <code>softcore/oo.fr</code>. Methods described above.
+
+<dt><code>C-REF <i></i></code><dd>
+
+
+
+Holds the signature of another object. Aggregate one of these into a data
+structure or container class to get polymorphic behavior. Methods and members:
+
+<dl>
+
+<dt><code>GET <i>( instance class -- ref-instance ref-class )</i></code><dd>
+
+
+Push the referenced object value on the stack.
+
+<dt><code>SET <i>( ref-instance ref-class instance class -- )</i></code><dd>
+
+
+Set the referenced object being held.
+
+<dt><code>.INSTANCE <i>( instance class -- a-address )</i></code><dd>
+
+
+Cell member that holds the instance.
+
+<dt><code>.CLASS <i>( instance class -- a-address )</i></code><dd>
+
+
+Cell member that holds the class.
+
+</dl>
+
+<dt><code>C-BYTE <i></i></code><dd>
+
+
+
+Primitive class derived from <code>OBJECT</code>, with a 1-byte payload. <code>SET</code>
+and <code>GET</code> methods perform correct width fetch and store. Methods and members:
+
+<dl>
+
+<dt><code>GET <i>( instance class -- byte )</i></code><dd>
+
+
+Push the object's value on the stack.
+
+<dt><code>SET <i>( byte instance class -- )</i></code><dd>
+
+
+Set the object's value from the stack.
+
+<dt><code>.PAYLOAD <i>( instance class -- address )</i></code><dd>
+
+
+Member holds instance's value.
+
+</dl>
+
+<dt><code>C-2BYTE <i></i></code><dd>
+
+
+
+Primitive class derived from <code>OBJECT</code>, with a 2-byte payload. <code>SET</code>
+and <code>GET</code> methods perform correct width fetch and store. Methods and members:
+
+<dl>
+
+<dt><code>GET <i>( instance class -- 2byte )</i></code><dd>
+
+
+Push the object's value on the stack.
+
+<dt><code>SET <i>( 2byte instance class -- )</i></code><dd>
+
+
+Set the object's value from the stack.
+
+<dt><code>.PAYLOAD <i>( instance class -- address )</i></code><dd>
+
+
+Member holds instance's value.
+
+</dl>
+
+<dt><code>C-4BYTE <i></i></code><dd>
+
+
+Primitive class derived from <code>object</code>, with a 4-byte payload. <code>SET</code>
+and <code>GET</code> methods perform correct width fetch and store. Methods and members:
+
+<dl>
+
+<dt><code>GET <i>( instance class -- 4byte )</i></code><dd>
+
+
+Push the object's value on the stack.
+
+<dt><code>SET <i>( 4byte instance class -- )</i></code><dd>
+
+
+Set the object's value from the stack.
+
+<dt><code>.PAYLOAD <i>( instance class -- address )</i></code><dd>
+
+
+Member holds instance's value.
+
+</dl>
+
+<dt><code>C-CELL <i></i></code><dd>
+
+
+
+Primitive class derived from <code>OBJECT</code>, with a cell payload (equivalent
+to <code>C-4BYTE</code> on 32 bit platforms, 64 bits wide on Alpha and other
+64-bit platforms). <code>SET</code>
+and <code>GET</code> methods perform correct width fetch and store. Methods and members:
+
+<dl>
+
+<dt><code>GET <i>( instance class -- 4byte )</i></code><dd>
+
+
+Push the object's value on the stack.
+
+<dt><code>SET <i>( 4byte instance class -- )</i></code><dd>
+
+
+Set the object's value from the stack.
+
+<dt><code>.PAYLOAD <i>( instance class -- address )</i></code><dd>
+
+
+Member holds instance's value.
+
+</dl>
+
+<dt><code>C-PTR <i></i></code><dd>
+
+
+
+Base class derived from <code>OBJECT</code> for pointers to non-object types.
+This class is not complete by itself: several methods depend on a derived
+class definition of <code>@SIZE</code>. Methods and members:
+
+<dl>
+
+<dt><code>.ADDR <i>( instance class -- a-address )</i></code><dd>
+
+
+Member variable, holds the pointer address.
+
+<dt><code>GET-PTR <i>( instance class -- pointer )</i></code><dd>
+
+
+Pushes the pointer address.
+
+<dt><code>SET-PTR <i>( pointer instance class -- )</i></code><dd>
+
+
+Sets the pointer address.
+
+<dt><code>INC-PTR <i>( instance class -- )</i></code><dd>
+
+
+Adds <code>@SIZE</code> to the pointer address.
+
+<dt><code>DEC-PTR <i>( instance class -- )</i></code><dd>
+
+
+Subtracts <code>@SIZE</code> to the pointer address.
+
+<dt><code>INDEX-PTR <i>( i instance class -- )</i></code><dd>
+
+
+Adds <code>i * @SIZE</code> to the pointer address.
+
+</dl>
+
+<dt><code>C-BYTEPTR <i></i></code><dd>
+
+
+
+Pointer to byte derived from <code>C-PTR</code>. Methods and members:
+
+<dl>
+
+<dt><code>@SIZE <i>( instance class -- size )</i></code><dd>
+
+
+Push size of the pointed-to object.
+
+<dt><code>GET <i>( instance class -- byte )</i></code><dd>
+
+
+Pushes the pointer's referent byte.
+
+<dt><code>SET <i>( byte instance class -- )</i></code><dd>
+
+
+Stores <code>byte</code> at the pointer address.
+
+</dl>
+
+
+
+<dt><code>C-2BYTEPTR <i></i></code><dd>
+
+
+
+Pointer to 2byte derived from <code>C-PTR</code>. Methods and members:
+
+<dl>
+
+<dt><code>@SIZE <i>( instance class -- size )</i></code><dd>
+
+
+Push size of the pointed-to object.
+
+<dt><code>GET <i>( instance class -- 2byte )</i></code><dd>
+
+
+Pushes the pointer's referent 2byte.
+
+<dt><code>SET <i>( 2byte instance class -- )</i></code><dd>
+
+
+Stores <code>2byte</code> at the pointer address.
+
+</dl>
+
+
+
+<dt><code>C-4BYTEPTR <i></i></code><dd>
+
+
+
+Pointer to 4byte derived from <code>C-PTR</code>. Methods and members:
+
+<dl>
+
+<dt><code>@SIZE <i>( instance class -- size )</i></code><dd>
+
+
+Push size of the pointed-to object.
+
+<dt><code>GET <i>( instance class -- 4byte )</i></code><dd>
+
+
+Pushes the pointer's referent 4byte.
+
+<dt><code>SET <i>( 4byte instance class -- )</i></code><dd>
+
+
+Stores <code>4byte</code> at the pointer address.
+
+</dl>
+
+
+<dt><code>C-CELLPTR <i></i></code><dd>
+
+
+
+Pointer to cell derived from <code>C-PTR</code>. Methods and members:
+
+<dl>
+
+<dt><code>@SIZE <i>( instance class -- size )</i></code><dd>
+
+
+Push size of the pointed-to object.
+
+<dt><code>GET <i>( instance class -- cell )</i></code><dd>
+
+
+Pushes the pointer's referent cell.
+
+<dt><code>SET <i>( cell instance class -- )</i></code><dd>
+
+
+Stores <code>cell</code> at the pointer address.
+
+</dl>
+
+
+
+<dt><code>C-STRING <i></i></code><dd>
+
+
+
+Dynamically allocated string, similar to MFC's <code>CString</code>.
+For more information, see <code>softcore/string.fr</code>.
+Partial list of methods and members:
+
+<dl>
+
+<dt><code>GET <i>( instance class -- c-address u )</i></code><dd>
+
+
+Pushes the string buffer's contents as a <code>C-ADDR U</code> style string.
+
+<dt><code>SET <i>( c-address u instance class -- )</i></code><dd>
+
+
+Sets the string buffer's contents to a new value.
+
+<dt><code>CAT <i>( c-address u instance class -- )</i></code><dd>
+
+
+Concatenates a string to the string buffer's contents.
+
+<dt><code>COMPARE <i>( c-address u instance class -- result )</i></code><dd>
+
+
+Lexical compiration of a string to the string buffer's contents.
+Return value is the same as the FORTH function <code>COMPARE</code>.
+
+<dt><code>TYPE <i>( instance class -- )</i></code><dd>
+
+
+Prints the contents of the string buffer to the output stream.
+
+<dt><code>HASHCODE <i>( instance class -- i )</i></code><dd>
+
+
+Returns a computed hash based on the contents of the string buffer.
+
+<dt><code>FREE <i>( instance class -- )</i></code><dd>
+
+
+Releases the internal buffer.
+
+</dl>
+
+
+<dt><code>C-HASHSTRING <i></i></code><dd>
+
+
+
+Subclass of <code>C-STRING</code>, which adds a member variable to store a hashcode.
+For more information, see <code>softcore/string.fr</code>.
+
+</dl>
+
+
+</blockquote><p></td></tr></table></body></html>
+
+
--- /dev/null
+++ b/doc/parsesteps.html
@@ -1,0 +1,388 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>ficl parse steps</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+ficl parse steps
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='ParseSteps'>
+Parse Steps
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+Unlike every other FORTH we know of, Ficl features an <i>extensible
+parser chain</i>. The Ficl parser is not a monolithic function; instead,
+it is comprised of a simple tokenizer and a series of <i>parse steps</i>.
+A parse step is a step in the parser chain that handles a particular kind
+of token, acting on the token as appropriate. Example parse steps, in
+terms of traditional FORTH lore, would be the "number runner" and the
+"colon compiler".
+<p>
+
+The Ficl parser works like this:
+<ol>
+
+<li>
+Read in a new <i>token</i> (string of text with no internal whitespace).
+
+<li>
+For each parse step in the chain, call the parse step, passing in the token.
+If the parse step returns <code>FICL_TRUE</code>, that parse step must have
+handled the token appropriately; move on to the next token.
+
+<li>
+If the parser tries all the parse steps and none of them return
+<code>FICL_TRUE</code>, the token is illegal—print an error
+and reset the virtual machine.
+
+</ol>
+
+Parse steps can be written as native functions, or as Ficl script functions.
+New parse steps can be appended to the chain at any time.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='TheDefaultFiclParseChain'>
+The Default Ficl Parse Chain
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+These is the default Ficl parser chain, shown in order.
+
+<dl>
+
+<dt>
+<code>?word</code>
+<dd>
+
+
+
+If compiling and local variable support is enabled, attempt to find the token in the local
+variable dictionary. If found, execute the token's compilation semantics and return <code>FICL_TRUE</code>.
+<p>
+
+Attempt to find the token in the system dictionary. If found, execute the token's semantics
+(may be different when compiling than when interpreting) and return <code>FICL_TRUE</code>.
+
+<dt>
+<code>?prefix</code>
+<dd>
+
+
+This parse step is only active if prefix support is enabled, setting <code>FICL_WANT_PREFIX</code>
+in <code>ficl.h</code> to a non-zero value.
+Attempt to match the beginning of the token to the list of known prefixes. If there's a match,
+execute the associated prefix method and return <code>FICL_TRUE</code>.
+
+<dt>
+<code>?number</code>
+<dd>
+
+
+Attempt to convert the token to a number in the present <code>BASE</code>. If successful, push the
+value onto the stack if interpreting, otherwise compile it, then return <code>FICL_TRUE</code>.
+
+<dt>
+<code>?float</code>
+<dd>
+
+
+This parse step is only active if floating-point number support is enabled,
+setting <code>FICL_WANT_FLOAT</code> in <code>ficl.h</code> to a non-zero value.
+Attempt to convert the token to a floating-point number. If successful, push the
+value onto the floating-point stack if interpreting, otherwise compile it,
+then return <code>FICL_TRUE</code>.
+
+</dl>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='AddingAParseStepFromWithinFicl'>
+Adding A Parse Step From Within Ficl
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<a name=ficlparsestep></a>
+
+You can add a parse step in two ways. The first is to write a Ficl word that
+has the correct stack signature for a parse step:
+<pre>
+<i>MY-PARSE-STEP</i> ( c-addr u -- x*i flag )
+</pre>
+where <code>c-addr u</code> are the address and length of the incoming token,
+and <code>flag</code> is <code>FICL_TRUE</code> if the parse step processed
+the token and <code>FICL_FALSE</code> otherwise.
+<p>
+
+Install the parse step using <code>add-parse-step</code>.
+A trivial example:
+<pre>
+: ?silly ( c-addr u -- flag )
+ ." Oh no! Not another " type cr true ;
+' ?silly add-parse-step
+parse-order
+</pre>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='AddingANativeParseStep'>
+Adding A Native Parse Step
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+The other way to add a parse step is to write it in C and add it into the
+parse chain with the following function:
+
+<pre>
+void ficlSystemAddPrimitiveParseStep(ficlSystem *system, char *name, ficlParseStep step);
+</pre>
+
+<code>name</code> is the display name of the parse step in the parse chain
+(as displayed by the Ficl word <code>PARSE-ORDER</code>). <code>step</code>
+is a pointer to the code for the parse step itself,
+and must match the following declaration:
+<pre>
+typedef int (*ficlParseStep)(ficlVm *vm, ficlString s);
+</pre>
+<p>
+
+When a native parse step is run, <code>si</code> points to the incoming token.
+The parse step must return <code>FICL_TRUE</code> if it succeeds in handling the
+token, and <code>FICL_FALSE</code> otherwise.
+See <code>ficlVmParseNumber()</code> in <code>system.c</code> for an example.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Prefixes'>
+Prefixes
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+What's a prefix, anyway? A prefix (contributed by Larry Hastings) is a token that's
+recognized as the beginning of another token. Its presence modifies the semantics of
+the rest of the token. An example is <code>0x</code>, which causes digits following
+it to be converted to hex regardless of the current value of <code>BASE</code>.
+<p>
+
+Caveat: Prefixes are matched in sequence, so the more of them there are,
+the slower the interpreter gets. On the other hand, because the prefix
+parse step occurs immediately after the dictionary lookup step, if you
+have a prefix for a particular purpose, using it may save time since it
+stops the parse process. Also, the Ficl interpreter is wonderfully fast,
+and most interpretation only happens once, so it's likely you won't notice
+any change in interpreter speed even if you make heavy use of prefixes.
+<p>
+
+Each prefix is a Ficl word stored in a special wordlist called <code><PREFIXES></code>. When the
+prefix parse step (<code>?prefix</code>, implemented in C as <code>ficlVmParsePrefix()</code>) is
+executed, it searches each word in <code><PREFIXES></code> in turn, comparing it with the
+initial characters of the incoming token. If a prefix matches, the parse step returns the remainder
+of the token to the input stream and executes the code associated with the prefix. This code can be
+anything you like, but it would typically do something with the remainder of the token. If the prefix
+code does not consume the rest of the token, it will go through the parse process again (which may
+be what you want).
+<p>
+
+Prefixes are defined in <code>prefix.c</code> and in <code>softcore/prefix.fr</code>.
+The best way to add prefixes is by defining them in your own code, bracketed with the special
+words <code>START-PREFIXES</code> and <code>END-PREFIXES</code>. For example, the following
+code would make <code>.(</code> a prefix.
+
+<pre>
+start-prefixes
+: .( .( ;
+end-prefixes
+</pre>
+<p>
+
+The compile-time constant <code>FICL_EXTENDED_PREFIX</code> controls the inclusion of
+several additional prefixes. This is turned off in the default build, since several
+of these prefixes alter standard behavior, but you might like them.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Notes'>
+Notes
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<ul>
+
+<li>
+Prefixes and parser extensions are non-standard. However, with the exception of
+prefix support, Ficl's default parse order follows the standard.
+Inserting parse steps in some other order will almost certainly break standard behavior.
+<p>
+
+<li>
+The number of parse steps that can be added to the system is limited by the value of
+<code>FICL_MAX_PARSE_STEPS</code> (defined in <code>sysdep.h</code>). The default
+maximum number is 8.
+<p>
+
+<li>
+The compile-time constant <code>FICL_EXTENDED_PREFIX</code> controls the inclusion of
+several additional prefixes. This is turned off in the default build, since several
+of these prefixes alter standard behavior, but you might like them.
+<p>
+
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='ParserGlossary'>
+Parser Glossary
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<dl>
+
+<dt>
+<code>PARSE-ORDER ( -- )</code>
+<dd>
+
+
+
+Prints the list of parse steps, in the order in which they are called.
+
+<dt>
+<code>ADD-PARSE-STEP ( xt -- )</code>
+<dd>
+
+
+
+Appends a parse step to the parse chain. <code>xt</code> is the address
+(execution token) of a Ficl word to use as the parse step. The word must be a
+legal Ficl parse step (<a href=#ficlparsestep>see above</a>).
+
+<dt>
+<code>SHOW-PREFIXES ( -- )</code>
+<dd>
+
+
+
+Prints the list of all prefixes. Each prefix is a Ficl word that is executed if its name
+is found at the beginning of a token.
+
+<dt>
+<code>START-PREFIXES ( -- )</code>
+<dd>
+
+
+
+Declares the beginning of a series of prefix definitions.
+Should be followed, eventually, by <code>END-PREFIXES</code>.
+(All <code>START-PREFIXES</code> does is tell the Ficl virtual machine
+to compile into the <code><PREFIXES></code> wordlist.)
+
+<dt>
+<code>END-PREFIXES ( -- )</code>
+<dd>
+
+
+
+Declares the end of a series of prefix definitions.
+Should only be used after calling <code>START-PREFIXES</code>.
+(All <code>END-PREFIXES</code> does is tell the Ficl virtual machine
+to switch back to the wordlist that was in use before <code>START-PREFIXES</code> was called.)
+
+</dl>
+
+
+
+</blockquote><p></td></tr></table></body></html>
+
--- /dev/null
+++ b/doc/releases.html
@@ -1,0 +1,1267 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>ficl release history</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+ficl release history
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version4031'>
+Version 4.0.31
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<ul>
+
+<li>
+First official release of new engine as Ficl 4! Hooray!
+
+<li>
+<code>ficlDictionarySee()</code> now takes a <code>ficlCallback</code>,
+so it knows where to print to. This is because <b>ficlWin</b> only
+sets a per-VM callback, which <i>should</i> work.
+
+<li>
+<code>ficlSystemCreate()</code> now passes in the system correctly
+into the dictionaries it creates, which lets dictionaries know what
+system they're a part of.
+
+<li>
+ficlCompatibility: Forgot to add the <code>errorTextOut</code> to the
+<code>ficl_system</code> structure (though I'd remembered to add it to
+the <code>ficl_vm</code> structure). This caused the <code>ficl_system</code>
+members after <code>textOut</code> to not line up with their equivalent
+<code>ficlSystem</code> members, which did bad things. (The bad thing
+in particular was calling <code>ficlDictionaryResetSearchOrder()</code>
+resulted in diddling the <code>vm->link</code> member, which strangely
+enough resulted in double-freeing the stacks.)
+
+<li>
+Added <code>ficlStackWalk()</code>, which walks a stack from top
+to bottom and calls your specified callback with each successive
+element. Cleaned up stack-printing functions as a result.
+
+<li>
+Changed <code>MULTICALL</code> so you can explicitly specify the vtable.
+
+<li>
+Changed XClasses so it explicitly specifies the vtable for
+non-virtual classes. This means you can now call a virtual
+method when you've <code>SUPER</code>ed an object and you'll
+get the method you wanted.
+
+<li>
+XClasses improvement: when removing a thunked method, remove
+the thunk variable too. Added <code>xClass.removeMember()</code>
+to support this.
+
+<li>
+XClasses now generates runtime stack-check code (<code>_DEBUG</code>
+only) for functions thunked from C to Ficl.
+
+<li>
+<code>FICL_WANT_PLATFORM</code> is now <code>0</code> by default.
+It is now set to <code>1</code> in the appropriate <code>ficlplatform/*.h</code>.
+
+<li>
+<code>softcore/win32.fr ENVIRONMENT? COMPARE<code> needed to be case-insensitive.
+
+<li>
+Whoops! Setting <code>FICL_PLATFORM_2INTEGER</code> to 0
+didn't compile. It now does, and works fine, as proved by
+the <code>ansi</code> platform.
+
+<li>
+Another whoops: contrib/xclasses/xclasses.py assumed that <code>"</code> (a prefix
+version of <code>S"</code>) defined. Switched to <code>S"</code>, which is safer.
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version4030'>
+Version 4.0.30
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<ul>
+
+<li>
+Cleaned up some <code>FICL_</code> definitions. Now all <code>FICL_HAVE_*</code> constants
+(and some other odds and ends) have been moved to <code>FICL_PLATFORM_</code>.
+
+<li>
+Whoops! Setting <code>FICL_PLATFORM_2INTEGER</code> to 0 didn't
+compile. It now does, and works fine, as proved by
+the <code>"ansi"</code> platform.
+
+<li>
+Another whoops: <code>contrib/xclasses/xclasses.py</code> assumed that <code>"</code> (a prefix
+version of <code>S"</code>) defined. Switched to <code>S"</code>, which is safer.
+
+<li>
+Added <code>ficlDictionarySetConstantString()</code>. 'Cause I needed it for:
+
+<li>
+Removed the <code>"WIN32"</code> <code>ENVIRONMENT?</code> setting, and added <code>"FICL_PLATFORM_OS"</code>
+and <code>"FICL_PLATFORM_ARCHITECTURE"</code> in its place. These are both <i>strings</i>.
+Updated <code>softcore/win32.fr</code> to match.
+
+<li>
+Compatibility: improved <code>ficlTextOut()</code> behavior. It makes life slightly
+less convenient for some users, but should be an improvement overall.
+The change: <code>ficlTextOut()</code> is now a compatibility-layer function that
+calls straight through to <code>vmTextOut()</code>. Lots of old code calls <code>ficlTextOut()</code>
+(naughty!). It's now explicit that you must set the <code>textOut</code> function
+by hand if you use a custom one... which is a good habit to get in to anyway.
+
+<li>
+Improved the documentation regarding upgrading, <code>ficllocals.h</code>, and compile-time
+constants.
+
+<li>
+Fixed <code>doc/source/generate.py</code> so it gracefully fails to copy over read-only
+files.
+
+<li>
+Got rid of every <code>#ifdef</code> in the sources. We now consistently use <code>#if defined()</code>
+everywhere. Similarly, got rid of all platform-switched <code>#if</code> code (except for the
+compatibility layer, sigh).
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version4029'>
+Version 4.0.29
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<ul>
+
+<li>
+Documentation totally reworked and updated.
+
+<li>
+<code>oldnames</code> renamed to <code>compatibility</code>.
+And improved, so that now Ficl 4 is basically a drop-in
+replacement for Ficl 3.
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version4028'>
+Version 4.0.28
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<ul>
+
+<li>
+Did backwards-compatibility testing. Ficl now drops in, more or less,
+with all the old Ficl-3.03-using projects I had handy.
+
+<li>
+Got Ficl compiling and running fine on Linux.
+
+<li>
+Weaned LZ77 code from needing htonl()/ntohl().
+
+<li>
+Moved all the primitives defined in "testmain.c" to their own file,
+"extras.c", and gave it its own global entry point.
+
+<li>
+Renamed "testmain.c" to just plain "main.c".
+
+<li>
+Renamed "softwords" directory to "softcore". More symmetrical.
+
+<li>
+Renamed "softcore\softcore.bat" to "make.bat". Added support for "CLEAN".
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version4027'>
+Version 4.0.27
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<ul>
+
+<li>
+Added runtime jump-to-jump peephole optimization in the new
+switch-threaded VM.
+
+<li>
+Fixed <code>INCLUDE-FILE</code> so it rethrows an exception in the
+subordinate evaluation.
+
+<li>
+Added a separate <code>errorOut</code> function to
+<code>ficlCallback()</code>,
+so under Windows you can have a jolly popup window to
+rub your nose in your failings.
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version4026'>
+Version 4.0.26
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<ul>
+
+<li>
+Namespace policing complete. There are now <i>no</i> external symbols
+which do not start with the word <code>ficl</code>.
+
+<li>
+Removed <code>ficlVmExec()</code>, renamed <code>ficlVmExecC()</code> to
+<code>ficlVmExecuteString()</code>, changed it to take a <code>ficlString()</code>.
+This is deliberate subterfuge on my part; I suspect most
+people who currently call <code>ficlVmExec() / ficlVmExecC()</code>
+should be calling <code>ficlVmEvaluate()</code>.
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version4025'>
+Version 4.0.25
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<ul>
+
+<li>
+First pass at support for "oldnames", and namespace policing.
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version4023'>
+Version 4.0.23
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+First alpha release of Ficl 4.0 rewrite. Coded, for better
+or for worse, by Larry Hastings.
+Ficl is <i>smaller</i>, <i>faster</i>, <i>more powerful</i>,
+and <i>easier to use</i> than ever before. (Or your money back!)
+<ul>
+<li>
+Rewrote Ficl's virtual machine; Ficl now runs nearly 3x faster out-of-the-box.
+The new virtual machine is of the "big switch statement" variety.
+
+<li>
+Renamed most (probably all) external Ficl functions and data structures.
+They now make sense and are (gasp!) consistent.
+
+<li>
+Retooled double-cell number support to take advantage of platforms
+which natively support double-cell-sized integers. (Like most modern
+32-bit platforms.)
+
+<li>
+Locals and VALUEs are now totally orthogonal; they can be single- or
+double-cell, and use the float or data stack. TO automatically supports all variants.
+
+<li>
+The "softcore" words can now be stored compressed, with a (current)
+savings of 11k. Decompression is nigh-instantaneous. You can choose
+whether or not you want softcore stored compressed at compile-time.
+
+<li>
+Reworked Win32 build process. Ficl now builds out-of-the-box on Win32
+as a static library, as a DLL, and as a command-line program,
+in each of the six possible runtime variants (Debug,Release x Singlethreaded,
+Multithreaded,Multithreaded DLL).
+
+<li>
+There's very likely other wonderful things that I've long forgotten
+about. If you notice them, feel free to remind me :)
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version303'>
+Version 3.03
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<ul>
+<li>
+Bugfix for floating-point numbers. Floats in compiled code were simply broken.
+
+<li>
+New words: <code>random</code> and <code>seed-random</code>
+
+<li>
+Bugfix: <code>included</code> never closed its file.
+
+<li>
+Bugfix: <code>include</code> was not <code>IMMEDIATE</code>.
+
+<li>
+Un-hid the OO words <code>parse-method</code>, <code>lookup-method</code>, and <code>find-method-xt</code>, as there are perfectly legitimate reasons why you might want to use them.
+
+<li>
+Changed the prefix version of <code>.(</code> to be <code>IMMEDIATE</code> too.
+
+<li>
+Fixed comment in Python softcore builder.
+
+<li>
+Put the <b>doc</b> directory back in to the distribution. (It was missing from 3.02... where'd it go?)
+
+</ul>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version302'>
+Version 3.02
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<ul>
+<li>
+Added support for <code>nEnvCells</code> (number of environment cells) to <code>FICL_SYSTEM_INFO</code>.
+
+<li>
+Consolidated <code>context</code> and <code>pExtend</code> pointers of <code>FICL_SYSTEM</code>—VM's <code>pExtend</code> pointer is initialized from the copy in <code>FICL_SYSTEM</code> upon VM creation.
+
+<li>
+Added <code>ficl-robust</code> environment variable.
+
+<li>
+Added <code>FW_ISOBJECT</code> word type.
+
+<li>
+Bugfix: <code>environment?</code> was ignoring the length of the supplied string.
+
+<li>
+Portability cleanup in fileaccess.c.
+
+<li>
+Bugfix in <code>ficlParsePrefix</code>: if the prefix dictionary isn't in the wordlist, the word being examined cannot be a prefix, so return failure.
+
+<li>
+<code>SEE</code> improvements: <code>SEE</code> (and consequently <code>DEBUG</code>) have improved source listings with instruction offsets.
+
+<li>
+It's turned off with the preprocessor, but we have the beginnings of a switch-threaded implementation of the inner loop.
+
+<li>
+Added <code>objectify</code> and <code>?object</code> for use by OO infrastructure.
+
+<li>
+<code>my=[</code> detects object members (using <code>?object</code>) and assumes all other members leave class unchanged.
+
+<li>
+Removed <code>MEMORY-EXT</code> environment variable (there is no such wordset).
+
+<li>
+Ficlwin changes:
+<ul>
+<li>
+Ficlwin character handling is more robust
+
+<li>
+Ficlwin uses multi-system constructs (see ficlthread.c)
+
+</ul>
+
+<li>
+Documentation changes:
+<ul>
+<li>
+Corrected various bugs in docs.
+
+<li>
+Added ficl-ized version of JV Noble's Forth Primer
+
+<li>
+Ficl OO tutorial expanded and revised. Thanks to David McNab for his demo and suggestions.
+
+</ul>
+
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version301'>
+Version 3.01
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<ul>
+<li>
+Major contributionss by Larry Hastings ([email protected]):
+<ul>
+<li>
+FILE wordset (fileaccess.c)
+
+<li>
+ficlEvaluate wrapper for ficlExec
+
+<li>
+ficlInitSystemEx makes it possible to bind selectable properties to VMs at create time
+
+<li>
+Python version of softcore builder ficl/softwords/softcore.py
+
+</ul>
+
+<li>
+Environment contains ficl-version (double)
+
+<li>
+?number handles trailing decimal point per DOUBLE wordset spec
+
+<li>
+Fixed broken .env (thanks to Leonid Rosin for spotting this goof)
+
+<li>
+Fixed broken floating point words that depended on evaluation order of stack pops.
+
+<li>
+env-constant
+
+<li>
+env-2constant
+
+<li>
+dictHashSummary is now commented out unless FICL_WANT_FLOAT (thanks to Leonid Rosin again)
+
+<li>
+Thanks to David McNab for pointing out that .( should be IMMEDIATE. Now it is.
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version300a'>
+Version 3.00a
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<ul>
+<li>
+Fixed broken oo.fr by commenting out vcall stuff using FICL_WANT_VCALL. Vcall is still broken.
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version300'>
+Version 3.00
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<ul>
+<li>
+Added pSys parameter to most ficlXXXX functions for multiple system support. Affected functions:
+<ul>
+<li>dictLookupLoc renamed to ficlLookupLoc after addition of pSys param
+<li>ficlInitSystem returns a FICL_SYSTEM*
+<li>ficlTermSystem
+<li>ficlNewVM
+<li>ficlLookup
+<li>ficlGetDict
+<li>ficlGetEnv
+<li>ficlSetEnv
+<li>ficlSetEnvD
+<li>ficlGetLoc
+<li>ficlBuild
+</ul>
+
+
+<li>Fixed off-by-one bug in ficlParsePrefix
+<li>Ficl parse-steps now work correctly - mods to interpret()
+<li>Made tools.c:isAFiclWord more selective
+<li>Tweaked makefiles and code to make gcc happy under linux
+<li>Vetted all instances of LVALUEtoCELL to make sure they're working on CELL sized operands
+(for 64 bit compatibility)
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version206'>
+Version 2.06
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<ul>
+<li>Debugger changes:
+<ul>
+<li>New debugger command "x" to execute the rest of the command line as ficl
+<li>New debugger command "l" lists the source of the innermost word being debugged
+<li>If you attempt to debug a primitive, it gets executed rather than doing nothing
+<li><code>R.S</code> displays the stack contents symbolically
+<li>Debugger now operates correctly under ficlwin, although ficlwin's key handling leaves a lot to be desired.
+<li><code>SEE</code> listing enhanced for use with the debugger
+</ul>
+<li>Added Guy Carver's changes to oo.fr for VTABLE support
+<li><code>float.c</code> words f> and >f to move floats to and from the param stack, analogous to >r and r>
+<li><code>LOOKUP</code> - Surrogate precompiled parse step for ficlParseWord (this step is hard
+ coded in <code>INTERPRET</code>)
+<li>License text at top of source files changed from LGPL to BSD by request
+<li>Win32 console version now handles exceptions more gracefully rather than crashing - uses win32
+structured exception handling.
+<li>Fixed BASE bug from 2.05 (was returning the value rather than the address)
+<li>Fixed ALLOT bug - feeds address units to dictCheck, which expects Cells. Changed dictCheck
+to expect AU.
+<li>Float stack display word renamed to f.s from .f to be consistent with r.s and .s
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version205'>
+Version 2.05
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+<h3>General</h3>
+
+<ul>
+<li>HTML documentation extensively revised
+<li>Incorporated Alpha (64 bit) patches from the freeBSD team.
+<li>Split SEARCH and SEARCH EXT words from words.c to search.c
+<li><a href="ficl_loc.html">2LOCALS</a> defined in <a href="ficl_loc.html#jhlocal">Johns Hopkins local syntax</a> now lose the first '2:' in their names.
+<li>Simple step <a href="ficl_debug.html">debugger</a> (see tools.c)
+<li>The text interpreter is now extensible - this is accomplished through the use
+of <code>ficlAddParseStep()</code>. <code>FICL_MAX_PARSE_STEPS</code> limits the number of parse steps
+(default: 8). You can write a precompiled parse step (see <code>ficlParseNumber</code>) and
+append it to the chain, or you can write one in ficl and use <code>ADD-PARSE-STEP</code>
+to append it. Default parse steps are initialized in <code>ficlInitSystem</code>. You can list
+the parse steps with <code>parse-order ( -- )</code>.
+<li>There is now a FICL_SYSTEM structure. This is a transitional release - version 3.0
+will alter several API prototypes to take this as a parameter, allowing multiple
+systems per process (and therefore multiple dictionaries). For those who use ficl
+under a virtual memory O/S like Linux or Win NT, you can just create multiple ficl
+processes (not threads) instead and save youself the wait.
+<li>Fixes for improved command line operation in testmain.c (Larry Hastings)
+<li>Numerous extensions to OO facility, including a new allot methods, ability
+to catch method invocations (thanks to Daniel Sobral again)
+<li>Incorporated Alpha (64 bit) patches contributed by Daniel Sobral and the freeBSD team
+Ficl is now 64 bit friendly! UNS32 is now FICL_UNS.
+<li>Split SEARCH and SEARCH EXT words from words.c to search.c
+<li>ABORT" now complies with the ANS (-2 THROWs)
+<li>Floating point support contributed by Guy Carver (Enable FICL_WANT_FLOAT in sysdep.h).
+<li>Win32 vtable model for objects (Guy Carver)
+<li>Win32 dll load/call suport (Larry Hastings)
+<li>Prefix support (Larry Hastings) (prefix.c prefix.fr FICL_EXTENDED_PREFIX) makes it
+easy to extend the parser to recignize prefixes like 0x and act on them. Use show-prefixes
+to see what's defined.
+<li>Cleaned up initialization sequence so that it's all in ficlInitSystem, and so that
+a VM can be created successfully before the dictionary is created
+</ul>
+
+<h3>
+Bug fixes</h3>
+
+<ul>
+<li>
+<a href="http://www.taygeta.com/forth/dpans9.htm#9.6.2.0680">ABORT"</a>
+now works correctly (I promise!)
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans6.htm#6.2.2125">REFILL</a> works
+better
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans6.htm#6.1.0710">ALLOT</a>'s
+use of dictCheck corrected (finally)
+</ul>
+
+<h3>
+New words</h3>
+
+<ul>
+<li>
+<a href="http://www.taygeta.com/forth/dpans6.htm#6.2.0415">2r@</a> <a href="http://www.taygeta.com/forth/dpans6.htm#6.2.0410">2r></a> <a href="http://www.taygeta.com/forth/dpans6.htm#6.2.0340">2>r</a>
+(CORE EXT)
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans8.htm#8.6.1.0440">2VARIABLE</a>
+(DOUBLE)
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans16.htm#16.6.2.1985">ORDER</a>
+now lists wordlists by name
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans15.htm#15.6.1.0220">.S</a> now
+displays all stack entries on one line, like a stack comment
+
+<li>
+<a href="ficl.html#wid-get-name"><tt>wid-get-name</tt> </a>
+given a wid, returns the address and count of its name. If no name, count
+is 0
+
+<li>
+<tt><a href="ficl.html#wid-set-name">wid-set-name</a></tt>
+set optional wid name pointer to the \0 terminated string address specified.
+
+<li>
+<tt><a href="ficl.html#ficlwordlist">ficl-named-wordlist</a></tt> creates
+a ficl-wordlist and names it. This is now used in <tt>vocabulary</tt> and
+<tt><a href="ficl.html#ficlvocabulary">ficl-vocabulary</a></tt>
+
+<li>
+<tt><a href="ficl.html#last-word">last-word</a></tt> returns the
+xt of the word being defined or most recently defined.
+
+<li>
+<tt><a href="ficl.html#qfetch">q@</a></tt> and <tt><a href="ficl.html#qbang">q!</a></tt>
+operate on quadbyte quantities for 64 bit friendliness
+</ul>
+
+<h3>
+New OO stuff</h3>
+
+<ul>
+<li>
+<tt>ALLOT (class method)</tt>
+
+<li>
+<tt>ALLOT-ARRAY (class method)</tt>
+
+<li>
+<tt>METHOD</tt> define method names globally
+
+<li>
+<tt>MY=></tt> early bind a method call to "this" class
+
+<li>
+<tt>MY=[ ]</tt> early bind a string of method calls to "this" class and
+obj members
+
+<li>
+<tt>C-></tt> late bind method invocation with CATCH
+
+<li>
+Metaclass method <tt>resume-class</tt> and instance word <tt>suspend-class</tt>
+create mutually referring classes. Example in string.fr
+
+<li>
+Early binding words are now in the instance-vars wordlist, not visible
+unless defining a class.
+
+<li>Support for refs to classes with VTABLE methods (contributed by Guy Carver). Guy writes:
+<p>
+My next favorite change is a set of VCALL words that allow me
+to call C++ class virtual methods from my forth classes. This
+is accomplished by interfacing with the VTABLE of the class. The
+class instance currently must be created on the C++ side.
+C++ places methods in the VTABLE in order of declaration in the
+header file. To use this in FICL one only needs to ensure
+that the VCALL: declerations occur in the same order. I use this
+quite a bit to interface with the C++ classes. When I need access
+to a method I make sure it is virtual (Even if it ultimately will
+not be). I use Visual C++ 6.0 and have not tested this under
+any other compiler but I believe VTABLE implementation is standard.
+</p><p>
+Here is an example of how to use VCALL:
+</p>
+<b>C++ class declaration</b>
+<pre>
+class myclass
+{+public:
+ myclass();
+ virtual ~myclass();
+ virtual void Test( int iParam1 );
+ virtual int Test( int iParam1, char cParam2 );
+ virtual float Test();
+};
+</pre>
+<b>ficl class declaration</b>
+<pre>
+object subclass myfclass hasvtable \ hasvtable adds 4 to the offset to
+ \ accommodate for the VTABLE pointer.
+0 VCALL: Destructor() \ VCALL: ( ParamCount -<MethodName>- )
+1 VCALL: Test(int) \ Test takes 1 int parameter.
+2 VCALLR: iTest(int,char) \ iTest takes 2 parameters and returns an int.
+0 VCALLF: fTest() \ fTest takes no parameters and returns a float.
+end-class
+
+MyCAddress \ Primitive to return a pointer to a "myclass" instance.
+myfclass -> ref dude \ This makes the MyCAddress pointer a myfclass
+ \ instance with the name "dude".
+1234 dude -> Test(int) \ Calls the virtual method Test.
+1234 1 dude -> iTest(int,char) . \ Calls iTest and emits the returned int.
+dude -> fTest() f. \ Calls fTest and emits the returned float.
+</pre>
+
+</ul>
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version204'>
+Version 2.04
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<h3>ficlwin</h3>
+
+<ul>
+<li>
+Catches exceptions thrown by VM in ficlThread (0 @ for example) rather
+than passing them off to the OS.
+</ul>
+
+<h3>
+ficl bugs vanquished</h3>
+
+<ul>
+<li>
+Fixed leading delimiter bugs in s" ." .( and ( (reported by Reuben Thomas)
+
+<li>
+Makefile tabs restored (thanks to Michael Somos)
+
+<li>
+ABORT" now throws -2 per the DPANS (thanks to Daniel Sobral for sharp eyes
+again)
+
+<li>
+ficlExec does not print the prompt string unless (source-id == 0)
+
+<li>
+Various fixes contributed by the FreeBSD team.
+</ul>
+
+<h3>
+ficl enhancements</h3>
+
+<ul>
+<li>
+Words.c: modified ficlCatch to use vmExecute and vmInnerLoop (request of
+Daniel Sobral) Added vmPop and vmPush functions (by request of Lars Krueger
+) in vm.c These are shortcuts to the param stack. (Use LVALUEtoCELL to
+get things into CELL form)
+
+<li>
+Added function vmGetStringEx with a flag to specify whether or not to skip
+lead delimiters
+
+<li>
+Added non-std word: number?
+
+<li>
+Added CORE EXT word AGAIN (by request of Reuben Thomas)
+
+<li>
+Added double cell local (2local) support
+
+<li>
+Augmented Johns Hopkins local syntax so that locals whose names begin with
+char 2 are treated as 2locals (OK - it's goofy, but handy for OOP)
+
+<li>
+C-string class revised and enhanced - now dynamically sized
+
+<li>
+C-hashstring class derived from c-string computes hashcode too.
+</ul>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version203'>
+Version 2.03
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+This is the first version of Ficl that includes contributed code. Thanks
+especially to Daniel Sobral, Michael Gauland for contributions and bug
+finding.
+<p>
+New words:
+<ul>
+<li>
+<tt><a href="#clock">clock</a>
+(FICL)</tt>
+
+<li>
+<tt><a href="#clockspersec">clocks/sec</a>
+(FICL)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans8.htm#8.6.1.1230">dnegate</a>
+(DOUBLE)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans10.htm#10.6.2.1905">ms</a>
+(FACILITY EXT - replaces MSEC <i>ficlWin only</i>)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans9.htm#9.6.1.2275">throw</a>
+(EXCEPTION)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans9.htm#9.6.1.0875">catch</a>
+(EXCEPTION)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans14.htm#14.6.1.0707">allocate</a>
+(MEMORY)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans14.htm#14.6.1.1605">free</a>
+(MEMORY)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans14.htm#14.6.1.2145">resize</a>
+(MEMORY)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans6.htm#6.2.2440">within</a>
+(CORE EXT)</tt>
+
+<li>
+<tt><a href="#alloc">alloc</a>
+(class method)</tt>
+
+<li>
+<tt><a href="#allocarray">alloc-array</a>
+(class method)</tt>
+
+<li>
+<tt><a href="#oofree">free</a>
+(class method)</tt>
+</ul>
+
+Bugs Fixed:
+<ul>
+<li>
+Bug fix in isNumber(): used to treat chars between 'Z' and 'a' as valid
+in base 10... (harmless, but weird)
+
+<li>
+ficlExec pushes the <i>ip</i> and <tt>interpret</tt>s at the right times
+so that nested calls to ficlExec behave the way you'd expect them to.
+
+<li>
+<tt>evaluate</tt> respects count parameter, and also passes exceptional
+return conditions back out to the calling instance of ficlExec.
+
+<li>
+VM_QUIT now clears the locals dictionary in ficlExec.
+</ul>
+Ficlwin Enhancements
+<ul>
+<li>
+File Menu: recent file list and Open now load files.
+
+<li>
+Text ouput function is now faster through use of string caching. Cache
+flushes at the end of each line and each time ficlExec returns.
+
+<li>
+Edit/paste now behaves more reasonably for text. File/open loads the specified
+file.
+
+<li>
+Registry entries specify dictionary and stack sizes, default window placement,
+and whether or not to create a splitter for multiple VMs. See HKEY_CURRENT_USER/Software/CodeLab/ficlwin/Settings
+</ul>
+Ficl Enhancements
+<ul>
+<li>
+This version includes changes to make it <b>64 bit friendly</b>. This unfortunately
+meant that I had to tweak some core data types and structures. I've tried
+to make this transparent to 32 bit code, but a couple of things got renamed.
+INT64 is now DPINT. UNS64 is now DPUNS. FICL_INT and FICL_UNS are synonyms
+for INT32 and UNS32 in 32 bit versions, but a are obsolescent. Please use
+the new data types instead. Typed stack operations on INT32 and UNS32 have
+been renamed because they operate on CELL scalar types, which are 64 bits
+wide on 64 bit systems. Added BITS_PER_CELL, which has legal values of
+32 or 64. Default is 32.
+
+<li>
+ficl.c: Added ficlExecXT() - executes an xt completely before returning,
+passing back any exception codes generated in the process. Normal exit
+code is VM_INNEREXIT.
+
+<li>
+ficl.c: Added ficlExecC() to operate on counted strings as opposed to zero
+terminated ones.
+
+<li>
+ficlExec pushes ip and executes interpret at the right times so that nested
+calls to ficlExec behave the way you'd expect them to.
+
+<li>
+ficlSetStackSize() allows specification of stack size at run-time (affects
+subsequent invocations of ficlNewVM()).
+
+<li>
+vm.c: vmThrow() checks for (pVM->pState != NULL) before longjmping it.
+vmCreate nulls this pointer initially.
+
+<li>
+EXCEPTION wordset contributed by Daniel Sobral of FreeBSD
+
+<li>
+MEMORY-ALLOC wordset contributed by Daniel Sobral, too. Added class methods
+<tt>alloc</tt>
+and <tt>alloc-array</tt> in softwords/oo.fr to allocate objects from the
+heap.
+
+<li>
+Control structure match check upgraded (thanks to Daniel Sobral for this
+suggestion). Control structure mismatches are now errors, not warnings,
+since the check accepts all syntactally legal constructs.
+
+<li>
+Added vmInnerLoop() to vm.h. This function/macro factors the inner
+interpreter out of ficlExec so it can be used in other places. Function/macro
+behavior is conditioned on INLINE_INNER_LOOP in sysdep.h. Default: 1 unless
+_DEBUG is set. In part, this is because VC++ 5 goes apoplectic when trying
+to compile it as a function. See
+
+<br>comments in vm.c
+<li>
+EVALUATE respects the count parameter, and also passes exceptional return
+conditions back out to the calling instance of ficlExec.
+
+<li>
+VM_QUIT clears locals dictionary in ficlExec()
+
+<li>
+Added Michael Gauland's ficlLongMul and ficlLongDiv and support routines
+to math64.c and .h. These routines are coded in C, and are compiled only
+if PORTABLE_LONGMULDIV == 1 (default is 0).
+
+<li>
+Added definition of ficlRealloc to sysdep.c (needed for memory allocation
+wordset). If your target OS supports realloc(), you'll probably want to
+redefine ficlRealloc in those terms. The default version does ficlFree
+followed by ficlMalloc.
+
+<li>
+testmain.c: Changed gets() in testmain to fgets() to appease the security
+gods.
+
+<li>
+testmain: <tt>msec</tt> renamed to <tt><a href="#ficlms">ms</a></tt> in
+line with the ANS
+
+<li>
+softcore.pl now removes comments & spaces at the start and end of lines.
+As a result: sizeof (softWords) == 7663 bytes (used to be 20000)
+and consumes 11384 bytes of dictionary when compiled
+
+<li>
+Deleted license paste-o in readme.txt (oops).
+</ul>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version202'>
+Version 2.02
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+New words:
+<ul>
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans6.htm#6.2.1850">marker</a>
+(CORE EXT)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans15.htm#15.6.2.1580">forget</a>
+(TOOLS EXT)</tt>
+
+<li>
+<tt><a href="#ficlforgetwid">forget-wid</a>
+(FICL)</tt>
+
+<li>
+<tt><a href="#ficlwordlist">ficl-wordlist</a> (FICL)</tt>
+
+<li>
+<tt><a href="#ficlvocabulary">ficl-vocabulary</a> (FICL)</tt>
+
+<li>
+<tt><a href="#ficlhide">hide</a>
+(FICL)</tt>
+
+<li>
+<tt><a href="#ficlhidden">hidden</a>
+(FICL)</tt>
+
+<li>
+<a href="#jhlocal">Johns Hopkins local variable syntax</a> (as best I can
+determine)
+</ul>
+Bugs Fixed
+<ul>
+<li>
+<tt>forget</tt> now adjusts the dictionary pointer to remove the name of
+the word being forgotten (name chars come before the word header in ficl's
+dictionary)
+
+<li>
+<tt>:noname</tt> used to push the colon control marker and its execution
+token in the wrong order
+
+<li>
+<tt>source-id</tt> now behaves correctly when loading a file.
+
+<li>
+<tt>refill</tt> returns zero at EOF (Win32 load). Win32 <tt><a href="#ficlload">load</a></tt>
+command continues to be misnamed. Really ought to be called <tt>included</tt>,
+but does not exactly conform to that spec either (because <tt>included</tt>
+expects a string signature on the stack, while Ficl's <tt><a href="#ficlload">load</a></tt>
+expects a filename upon invocation). The "real" <tt>LOAD</tt> is a <tt>BLOCK</tt>
+word.
+</ul>
+Enhancements (IMHO)
+<ul>
+<li>
+dictUnsmudge no longer links anonymous definitions into the dictionary
+
+<li>
+<tt>oop</tt> is no longer the default compile wordlist at startup, nor
+is it in the search order. Execute <b><tt>also oop definitions</tt></b>
+to use Ficl OOP.
+
+<li>
+Revised oo.fr extensively to make more use of early binding
+
+<li>
+Added <tt>meta</tt> - a constant that pushes the address of metaclass.
+See oo.fr for examples of use.
+
+<li>
+Added classes: <tt>c-ptr c-bytePtr c-2bytePtr c-cellPtr
+</tt>These
+classes model pointers to non-object data, but each knows the size of its
+referent.
+</ul>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version201'>
+Version 2.01
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<ul>
+<li>
+Bug fix: <tt>(local)</tt> used to leave a value on the stack between the
+first and last locals declared. This value is now stored in a static.
+
+<li>
+Added new local syntax with parameter re-ordering. <a href="#newlocal">See
+description below</a>. (No longer compiled in version 2.02, in favor of
+the Johns Hopkins syntax)
+</ul>
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='Version20'>
+Version 2.0
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<ul>
+<li>
+New ANS Forth words: <tt>TOOLS</tt> and part of <tt>TOOLS EXT, SEARCH</tt>
+and <tt>SEARCH EXT, LOCALS</tt> and <tt>LOCALS EXT</tt> word sets, additional
+words from <tt>CORE EXT, DOUBLE</tt>, and <tt>STRING</tt>. (See the function
+ficlCompileCore in words.c for an alphabetical list by word set).
+
+<li>
+Simple <tt>USER</tt> variable support - a user variable is a virtual machine
+instance variable. User variables behave as <tt>VARIABLE</tt>s in all other
+respects.
+
+<li>
+Object oriented syntax extensions (see below)
+
+<li>
+Optional stack underflow and overflow checking in many CORE words (enabled
+when FICL_ROBUST >= 2)
+
+<li>
+Various bug fixes
+</ul>
+
+
+
+
+</blockquote><p></td></tr></table></body></html>
+
+
--- /dev/null
+++ b/doc/source/api.ht
@@ -1,0 +1,250 @@
+<?
+ficlPageHeader("ficl api")+
+ficlAddToNavBarAs("API")+
+
+def entrypoint(prototype):
+ print "<p><dt>\n" + "<code>" + prototype + "</code>\n<dd>\n"
+?>
+
+
+
+<? ficlHeader1("Quick Ficl Programming Concepts Overview") ?>+
+
+A Ficl <i>dictionary</i> is equivalent to the FORTH "dictionary"; it is where words are stored.
+A single dictionary has a single <code>HERE</code> pointer.
+<p>
+
+A Ficl <i>system information</i> structure is used to change default values used
+in initializing a Ficl <i>system</i>.
+<p>
+
+A Ficl <i>system</i> contains a single <i>dictionary</i>, and one or more <i>virtual machines</i>.
+<p>
+
+A Ficl <i>stack</i> is equivalent to a FORTH "stack". Ficl has three stacks:
+<ul>
+
+<li>
+The <i>data</i> stack, where integer arguments are stored.
+
+<li>
+The <i>return</i> stack, where locals and return addresses for subroutine returns are stored.
+
+<li>
+The <i>float</i> stack, where floating-point arguments are stored. (This stack
+is only enabled when <code>FICL_WANT_FLOAT</code> is nonzero.)
+</ul>
+
+<p>
+
+A Ficl <i>virtual machine</i> (or <i>vm</i>) represents a single running instance of the Ficl interpreter.
+All virtual machines in a single Ficl system see the same dictionary.
+<p>
+
+<? ficlHeader2("Quick Ficl Programming Tutorial") ?>+
+Though Ficl's API offers a great deal of flexibility, most programs
+incorporating Ficl simply use it as follows:
+
+<ol>
+
+<li>
+Create a single <code>ficlSystem</code> using <code>ficlSystemCreate(NULL)</code>.
+
+<li>
+Add native functions as necessary with <code>ficlDictionarySetPrimitive()</code>.
+
+<li>
+Add constants as necessary with <code>ficlDictionarySetConstant()</code>.
+
+<li>
+Create one (or more) virtual machine(s) with <code>ficlSystemCreateVm()</code>.
+
+<li>
+Add one or more scripted functions with <code>ficlVmEvaluate()</code>.
+
+<li>
+Execute code in a Ficl virtual machine, usually with <code>ficlVmEvaluate()</code>,
+but perhaps with <code>ficlVmExecuteXT()</code>.
+
+<li>
+At shutdown, call <code>ficlSystemDestroy()</code> on the single Ficl system.
+
+</ol>
+
+
+<? ficlHeader1("Ficl Application Programming Interface") ?>+
+The following is a partial listing of functions that interface your
+system or program to Ficl. For a complete listing, see <code>ficl.h</code>
+(which is heavily commented). For a simple example, see <code>main.c</code>.
+<p>
+
+Note that as of Ficl 4, the API is internally consistent.
+<i>Every</i> external entry point starts with the word
+<code>ficl</code>, and the word after that also corresponds
+with the first argument. For instance, a word that operates
+on a <code>ficlSystem *</code> will be called <code>ficlSystem<i>Something</i>()</code>.
+
+
+
+
+<dl>
+
+<? entrypoint("void ficlSystemInformationInitialize(ficlSystemInformation *fsi)") ?>+
+Resets a <code>ficlSystemInformation</code> structure to all zeros.
+(Actually implemented as a macro.) Use this to initialize a <code>ficlSystemInformation</code>
+structure before initializing its members and passing it
+into <code>ficlSystemCreate()</code> (below).
+
+<? entrypoint("ficlSystem *ficlSystemCreate(ficlSystemInformation *fsi)") ?>+
+Initializes Ficl's shared system data structures, and creates the
+dictionary allocating the specified number of cells from the heap
+(by a call to <code>ficlMalloc()</code>). If you pass in a <code>NULL</code>
+pointer, you will recieve a <code>ficlSystem</code> using the default
+sizes for the dictionary and stacks.
+
+
+<? entrypoint("void ficlSystemDestroy(ficlSystem *system)") ?>+
+Reclaims memory allocated for the Ficl system including all
+dictionaries and all virtual machines created by
+<code>ficlSystemCreateVm()</code>. Note that this will <i>not</i>
+automatically free memory allocated by the FORTH memory allocation
+words (<code>ALLOCATE</code> and <code>RESIZE</code>).
+
+<? entrypoint("ficlWord *ficlDictionarySetPrimitive(ficlDictionary *dictionary, char *name, ficlCode code, ficlUnsigned8 flags)") ?>+
+Adds a new word to the dictionary with the given
+name, code pointer, and flags. To add
+<p>
+
+The <code>flags</code> parameter is a bitfield. The valid
+flags are:<ul>
+
+<li>
+FICL_WORD_IMMEDIATE
+<li>
+FICL_WORD_COMPILE_ONLY
+<li>
+FICL_WORD_SMUDGED
+<li>
+FICL_WORD_OBJECT
+<li>
+FICL_WORD_INSTRUCTION
+
+</ul>
+
+For more information on these flags, see <code>ficl.h</code>.
+
+
+<? entrypoint("ficlVm *ficlSystemCreateVm(ficlSystem *system)") ?>+
+Creates a new virtual machine in the specified system.
+
+
+<? entrypoint("int ficlVmEvaluate(ficlVm *vm, char *text)") ?>+
+ the specified C string (zero-terminated) to the given
+virtual machine for evaluation. Returns various exception codes (VM_XXXX
+in ficl.h) to indicate the reason for returning. Normal exit
+condition is VM_OUTOFTEXT, indicating that the VM consumed the string
+successfully and is back for more. Calls to <code>ficlVmEvaluate()</code>
+can be nested, and
+the function itself is re-entrant, but note that a VM is
+static, so you have to take reasonable precautions (for example, use one
+VM per thread in a multithreaded system if you want multiple threads to
+be able to execute commands).
+
+
+<? entrypoint("int ficlVmExecuteXT(ficlVm *vm, ficlWord *pFW)") ?>+
+Same as ficlExec, but takes a pointer to a ficlWord instead of a
+string. Executes the word and returns after it has finished. If
+executing the word results in an exception, this function will
+re-throw the same code if it is nested under another ficlExec family
+function, or return the exception code directly if not. This function
+is useful if you need to execute the same word repeatedly—you
+save the dictionary search and outer interpreter overhead.
+
+<? entrypoint("void ficlFreeVM(ficlVm *vm)") ?>+
+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.
+
+<? entrypoint("ficlVm *ficlNewVM(ficlSystem *system)") ?>+
+Create, initialize, and return a VM from the heap using
+ficlMalloc. Links the VM into the system VM list for later reclamation
+by ficlTermSystem.
+
+<? entrypoint("ficlWord *ficlSystemLookup(ficlSystem *system, char *name)") ?>+
+Returns the address of the specified word in the main dictionary.
+If no such word is found, it returns <code>NULL</code>.
+The address is also a valid execution token, and can be used in a call to <code>ficlVmExecuteXT()</code>.
+
+<? entrypoint("ficlDictionary *ficlSystemGetDictionary(ficlSystem *system)<br>ficlDictionary *ficlVmGetDictionary(ficlVm *system)") ?>+
+Returns a pointer to the main system dictionary.
+
+
+<? entrypoint("ficlDictionary *ficlSystemGetEnvironment(ficlSystem *system)") ?>+
+Returns a pointer to the environment dictionary. This dictionary
+stores information that describes this implementation as required by the
+Standard.
+
+
+
+
+<? entrypoint("ficlDictionary *ficlSystemGetLocals(ficlSystem *system)") ?>+
+Returns a pointer to the locals dictionary. This function is
+defined only if <code>FICL_WANT_LOCALS</code> is non-zero (see <code>ficl.h</code>).
+The locals dictionary is the symbol table for
+<a href="locals.html">local variables</a>.
+
+
+</dl>
+
+
+<? ficlHeader1("Ficl Compile-Time Constants") ?>+
+There are a lot of preprocessor constants you can set at compile-time
+to modify Ficl's runtime behavior. Some are required, such as telling
+Ficl whether or not the local platform supports double-width integers
+(<code>FICL_PLATFORM_HAS_2INTEGER</code>);
+some are optional, such as telling Ficl whether or not to use the
+extended set of "prefixes" (<code>FICL_WANT_EXTENDED_PREFIXES</code>).
+<p>
+
+The best way to find out more about these constants is to read <code>ficl.h</code>
+yourself. The settings that turn on or off Ficl modules all start with
+<code>FICL_WANT</code>. The settings relating to functionality available
+on the current platform all start with <code>FICL_PLATFORM</code>.
+<p>
+
+
+
+<? ficlHeader2("<code>ficllocal.h</code>") ?>+
+One more note about constants. Ficl now ships with a standard place for
+you to tweak the Ficl compile-time preprocessor constants.
+It's a file called <code>ficllocal.h</code>, and we guarantee that it
+will always ship empty (or with only comments). We suggest that you
+put all your local changes there, rather than editing <code>ficl.h</code>
+or editing the makefile. That should make it much easier to integrate
+future Ficl releases into your product—all you need do is preserve
+your tweaked copy of <code>ficllocal.h</code> and replace the rest.
+
+
+
+<? ficlPageFooter() ?>
--- /dev/null
+++ b/doc/source/debugger.ht
@@ -1,0 +1,157 @@
+<?
+ficlPageHeader("ficl debugger")+
+ficlAddToNavBarAs("Debugger")+
+?>
+
+<p>Ficl includes a simple step debugger for colon definitions
+and <code>DOES></code> words.
+
+
+<? ficlHeader1("Using The Ficl Debugger") ?>+
+
+To debug a word, set up the stack with any parameters the word requires,
+then execute:
+<pre><b>DEBUG <i>your-word-name-here</i></b></pre>
+<p>
+
+If the word is unnamed, or all you have is an execution token,
+you can instead use <code>DEBUG-XT</code></b>
+<p>
+
+The debugger invokes <tt>SEE</tt> on the word which prints a crude source
+listing. It then stops at the first instruction of the definition. There are
+six (case insensitive) commands you can use from here onwards:
+
+<dl>
+
+<dt>
+<b>I</b> (step <b>I</b>n)
+<dd>If the next instruction is a colon defintion or does> word, steps into
+that word's code. If the word is a primitive, simply executes the word.
+
+<dt>
+<b>O</b> (step <b>O</b>ver)
+<dd>
+Executes the next instruction in its entirety.
+
+<dt>
+<b>G</b> (<b>G</b>o)
+<dd>
+Run the word to completion and exit the debugger.
+
+<dt>
+<b>L</b> (<b>L</b>ist)
+<dd>
+Lists the source code of the word presently being stepped.
+
+<dt>
+<b>Q</b> (<b>Q</b>uit)
+<dd>
+Abort the word and exit the debugger, clearing the stacks.
+
+<dt>
+<b>X</b> (e<b>X</b>ecute)
+<dd>
+Interpret the remainder of the line as Ficl words. Any change
+they make to the stacks will be preserved when the debugged word
+continues execution.
+Any errors will abort the debug session and reset the VM. Usage example:
+<pre>
+X DROP 3 \ change top argument on stack to 3
+</pre>
+
+</dl>
+
+
+Any other character will prints a list of available debugger commands.
+
+
+<? ficlHeader2("The <code>ON-STEP</code> Event") ?>+
+If there is a defined word named <code>ON-STEP</code> when the debugger starts, that
+word will be executed before every step. Its intended use is to display the stacks
+and any other VM state you find interesting. The default <code>ON-STEP</code> is:
+<p>
+
+<pre>
+: ON-STEP ." S: " .S-SIMPLE CR ;
+</pre>
+
+If you redefine <code>ON-STEP</code>, we recommend you ensure the word has no
+side-effects (for instance, adding or removing values from any stack).
+
+
+
+<? ficlHeader3("Other Useful Words For Debugging And <code>ON-STEP</code>") ?>+
+<dl>
+
+<dt>
+<code>.ENV ( -- )</code>
+<dd>
+Prints all environment settings non-destructively.
+
+<dt>
+<code>.S ( -- )</code>
+<dd>
+Prints the parameter stack non-destructively in a verbose format.
+
+<dt>
+<code>.S-SIMPLE ( -- )</code>
+<dd>
+Prints the parameter stack non-destructively in a simple single-line format.
+
+<dt>
+<code>F.S ( -- )</code>
+<dd>
+Prints the float stack non-destructively (only available if <code>FICL_WANT_FLOAT</code> is enabled).
+
+<dt>
+<code>R.S ( -- )</code>
+<dd>
+Prints a represention of the state of the return stack non-destructively.
+
+
+
+</dl>
+
+<? ficlHeader1("Debugger Internals") ?>+
+<p>
+The debugger words are mostly located in source file <code>tools.c</code>. There are
+supporting words (<code>DEBUG</code> and <code>ON-STEP</code>) in <code>softcore.fr</code> as well.
+There are two main words that make the debugger go: <code>debug-xt</code> and <code>step-break</code>.
+<code>debug-xt</code> takes the execution token of a word to debug (as returned by <code>'</code> for example) ,
+checks to see if it is debuggable (not a primitive), sets a breakpoint at its
+first instruction, and runs <code>see</code> on it. To set a breakpoint,
+<code>debug-xt</code>
+replaces the instruction at the breakpoint with the execution token of <code>step-break</code>, and
+stores the original instruction and its address in a static breakpoint
+record. To clear the breakpoint, <code>step-break</code> simply replaces the original
+instruction and adjusts the target virtual machine's instruction pointer
+to run it.
+
+<p>
+
+<code>step-break</code> is responsible for processing debugger commands and setting
+breakpoints at subsequent instructions.
+
+
+<? ficlHeader1("Future Enhancements") ?>+
+<dl>
+
+<li>
+The debugger needs to exit automatically when it encounters the end of the word
+it was asked to debug. (Perhaps this could be a special kind of breakpoint?)
+
+<li>Add user-set breakpoints.
+
+<li>Add "step out" command.
+</dl>
+
+
+<? ficlPageFooter() ?>
--- /dev/null
+++ b/doc/source/dpans.ht
@@ -1,0 +1,589 @@
+<?
+ficlPageHeader("ficl standards compliance")+
+ficlHeader1("ANS Required Information")+
+ficlAddToNavBarAs("ANS")+
+?>
+
+
+The following documentation is necessary to comply for Ficl
+to comply with the DPANS94 standard. It describes what areas
+of the standard Ficl implements, what areas it does not, and
+how it behaves in areas undefined by the standard.
+
+<blockquote>
+
+<? ficlHeader2("ANS Forth System") ?>+
+<b>
+
+Providing names from the Core Extensions word set
+<br>
+
+Providing names from the Double-Number word set
+<br>
+
+Providing the Exception word set
+<br>
+
+Providing the Exception Extensions word set
+<br>
+
+Providing the File-Access word set
+<br>
+
+Providing the File-Access Extensions word set
+<br>
+
+Providing names from the Floating-Point word set
+<br>
+
+Providing the Locals word set
+<br>
+
+Providing the Locals Extensions word set
+<br>
+
+Providing the Memory Allocation word set
+<br>
+
+Providing the Programming-Tools word set
+<br>
+
+Providing names from the Programming-Tools Extensions word set
+<br>
+
+Providing the Search-Order word set
+<br>
+
+Providing the Search-Order Extensions word set
+<br>
+
+Providing names from the String Extensions word set
+<br>
+
+</b>
+
+
+<?
+def entry(heading):
+ print "<dt><b>\n" + heading + "\n</b><dd>\n"
+
+?>
+
+
+<? ficlHeader2("Implementation-defined Options") ?>+
+The implementation-defined items in the following list represent
+characteristics and choices left to the discretion of the implementor,
+provided that the requirements of the Standard are met. A system shall
+document the values for, or behaviors of, each item.
+
+<dl>
+
+<? entry("aligned address requirements (3.1.3.3 Addresses)") ?>+
+System dependent. You can change the default address alignment by
+defining <code>FICL_ALIGN</code> on your compiler's command line,
+or in <code>platform.h</code>.
+The default value is set to 2 in <code>ficl.h</code>.
+This causes dictionary entries and <code>ALIGN</code> and
+<code>ALIGNED</code> to align on 4 byte
+boundaries. To align on 2<b><sup>n</sup></b> byte boundaries,
+set <code>FICL_ALIGN</code> to <b>n</b>.
+
+
+<? entry("behavior of 6.1.1320 EMIT for non-graphic characters") ?>+
+Depends on target system, C runtime library, and your
+implementation of <code>ficlTextOut()</code>.
+
+
+<? entry("character editing of 6.1.0695 ACCEPT and 6.2.1390 EXPECT") ?>+
+None implemented in the versions supplied in <code>primitives.c</code>.
+Because <code>ficlEvaluate()</code> is supplied a text buffer
+externally, it's up to your system to define how that buffer will
+be obtained.
+
+
+<? entry("character set (3.1.2 Character types, 6.1.1320 EMIT, 6.1.1750 KEY)") ?>+
+Depends on target system and implementation of <code>ficlTextOut()</code>.
+
+
+<? entry("character-aligned address requirements (3.1.3.3 Addresses)") ?>+
+Ficl characters are one byte each. There are no alignment requirements.
+
+
+<? entry("character-set-extensions matching characteristics (3.4.2 Finding definition names)") ?>+
+No special processing is performed on characters beyond case-folding. Therefore,
+extended characters will not match their unaccented counterparts.
+
+
+<? entry("conditions under which control characters match a space delimiter (3.4.1.1 Delimiters)") ?>+
+Ficl uses the Standard C function <code>isspace()</code> to distinguish space characters.
+
+
+<? entry("format of the control-flow stack (3.2.3.2 Control-flow stack)") ?>+
+Uses the data stack.
+
+
+<? entry("conversion of digits larger than thirty-five (3.2.1.2 Digit conversion)") ?>+
+The maximum supported value of <code>BASE</code> is 36.
+Ficl will fail via assertion in function <code>ltoa()</code> of <code>utility.c</code>
+if the base is found to be larger than 36 or smaller than 2. There will be no effect
+if <code>NDEBUG</code> is defined, however, other than possibly unexpected behavior.
+
+
+<? entry("display after input terminates in 6.1.0695 ACCEPT and 6.2.1390 EXPECT") ?>+
+Target system dependent.
+
+
+<? entry("exception abort sequence (as in 6.1.0680 ABORT\")") ?>+
+Calls <tt>ABORT</tt> to exit.
+
+
+<? entry("input line terminator (3.2.4.1 User input device)") ?>+
+Target system dependent (implementation of outer loop that calls <code>ficlEvaluate()</code>).
+
+
+<? entry("maximum size of a counted string, in characters (3.1.3.4 Counted strings, 6.1.2450 WORD)") ?>+
+Counted strings are limited to 255 characters.
+
+
+<? entry("maximum size of a parsed string (3.4.1 Parsing)") ?>+
+Limited by available memory and the maximum unsigned value that can fit in a cell (2<sup>32</sup>-1).
+
+
+<? entry("maximum size of a definition name, in characters (3.3.1.2 Definition names)") ?>+
+Ficl stores the first 31 characters of a definition name.
+
+
+<? entry("maximum string length for 6.1.1345 ENVIRONMENT?, in characters") ?>+
+Same as maximum definition name length.
+
+
+<? entry("method of selecting 3.2.4.1 User input device") ?>+
+None supported. This is up to the target system.
+
+
+<? entry("method of selecting 3.2.4.2 User output device") ?>+
+None supported. This is up to the target system.
+
+
+<? entry("methods of dictionary compilation (3.3 The Forth dictionary)") ?>+
+Okay, we don't know what this means. If you understand what they're asking for here,
+please call the home office.
+
+
+<? entry("number of bits in one address unit (3.1.3.3 Addresses)") ?>+
+Target system dependent, either 32 or 64 bits.
+
+
+<? entry("number representation and arithmetic (3.2.1.1 Internal number representation)") ?>+
+System dependent. Ficl represents a CELL internally as a union that can hold a <code>ficlInteger32</code>
+(a signed 32 bit scalar value), a <code>ficlUnsigned32</code> (32 bits unsigned),
+and an untyped pointer. No specific byte ordering is assumed.
+
+
+<? entry("ranges for n, +n, u, d, +d, and ud (3.1.3 Single-cell types, 3.1.4 Cell-pair types)") ?>+
+System dependent.
+Assuming a 32 bit implementation, range for signed single-cell values is [-2<sup>31</sup>, 2<sup>31</sup>-1].
+Range for unsigned single cell values is [0, 2<sup>32</sup>-1].
+Range for signed double-cell values is [-2<sup>63</sup>, 2<sup>63</sup>-1].
+Range for unsigned double cell values is [0, 2<sup>64</sup>-1].
+
+
+<? entry("read-only data-space regions (3.3.3 Data space)") ?>+
+None.
+
+
+<? entry("size of buffer at 6.1.2450 WORD (3.3.3.6 Other transient regions)") ?>+
+Default is 255. Depends on the setting of <code>FICL_PAD_SIZE</code> in <code>ficl.h</code>.
+
+
+<? entry("size of one cell in address units (3.1.3 Single-cell types)") ?>+
+System dependent, generally 4.
+
+
+<? entry("size of one character in address units (3.1.2 Character types)") ?>+
+System dependent, generally 1.
+
+
+<? entry("size of the keyboard terminal input buffer (3.3.3.5 Input buffers)") ?>+
+This buffer is supplied by the host program. Ficl imposes no practical limit.
+
+
+<? entry("size of the pictured numeric output string buffer (3.3.3.6 Other transient regions)") ?>+
+Default is 255. Depends on the setting of <code>FICL_PAD_SIZE</code> in <code>ficl.h</code>.
+
+
+<? entry("size of the scratch area whose address is returned by 6.2.2000 PAD (3.3.3.6 Other transient regions)") ?>+
+Default is 255. Depends on the setting of <code>FICL_PAD_SIZE</code> in <code>ficl.h</code>.
+
+
+<? entry("system case-sensitivity characteristics (3.4.2 Finding definition names)") ?>+
+The Ficl dictionary is not case-sensitive.
+
+
+<? entry("system prompt (3.4 The Forth text interpreter, 6.1.2050 QUIT)") ?>+
+<code>ok></code>
+
+
+<? entry("type of division rounding (3.2.2.1 Integer division, 6.1.0100 */, 6.1.0110 */MOD, 6.1.0230 /, 6.1.0240 /MOD, 6.1.1890 MOD)") ?>+
+Symmetric.
+
+
+<? entry("values of 6.1.2250 STATE when true") ?>+
+1.
+
+
+<? entry("values returned after arithmetic overflow (3.2.2.2 Other integer operations)") ?>+
+System dependent. Ficl makes no special checks for overflow.
+
+
+<? entry("whether the current definition can be found after 6.1.1250 DOES> (6.1.0450 :)") ?>+No. Definitions are unsmudged after ; only, and only then if no control structure matching problems have been detected.
+
+</dl>
+
+
+<? ficlHeader2("Ambiguous Conditions") ?>+
+<dl>
+
+<? entry("a name is neither a valid definition name nor a valid number during text interpretation (3.4 The Forth text interpreter)") ?>+
+Ficl calls <code>ABORT</code> then prints the name followed by <code>not found</code>.
+
+
+<? entry("a definition name exceeded the maximum length allowed (3.3.1.2 Definition names)") ?>+
+Ficl stores the first 31 characters of the definition name, and uses all characters of the name
+in computing its hash code. The actual length of the name, up to 255 characters, is stored in
+the definition's length field.
+
+
+<? entry("addressing a region not listed in 3.3.3 Data Space") ?>+
+No problem: all addresses in Ficl are absolute. You can reach any 32 bit address in Ficl's address space.
+
+
+<? entry("argument type incompatible with specified input parameter, e.g., passing a flag to a word expecting an n (3.1 Data types)") ?>+
+Ficl makes no check for argument type compatibility. Effects of a mismatch vary widely depending on the specific problem and operands.
+
+
+<? entry("attempting to obtain the execution token, (e.g., with 6.1.0070 ', 6.1.1550 FIND, etc.) of a definition with undefined interpretation semantics") ?>+
+Ficl returns a valid token, but the result of executing that token while interpreting may be undesirable.
+
+
+<? entry("dividing by zero (6.1.0100 */, 6.1.0110 */MOD, 6.1.0230 /, 6.1.0240 /MOD, 6.1.1561 FM/MOD, 6.1.1890 MOD, 6.1.2214 SM/REM, 6.1.2370 UM/MOD, 8.6.1.1820 M*/)") ?>+
+Results are target procesor dependent. Generally, Ficl makes no check for divide-by-zero. The target processor will probably throw an exception.
+
+
+<? entry("insufficient data-stack space or return-stack space (stack overflow)") ?>+
+With <code>FICL_ROBUST</code> (defined in <code>ficl.h</code>) set to a value of 2 or greater,
+most data, float, and return stack operations are checked for underflow and overflow.
+
+
+<? entry("insufficient space for loop-control parameters") ?>+
+This is not checked, and bad things will happen.
+
+
+<? entry("insufficient space in the dictionary") ?>+
+Ficl generates an error message if the dictionary is too full to create
+a definition header. It checks <code>ALLOT</code> as well, but it is possible
+to make an unchecked allocation request that will overflow the dictionary.
+
+
+<? entry("interpreting a word with undefined interpretation semantics") ?>+
+Ficl protects all ANS Forth words with undefined interpretation semantics from being executed while in interpret state.
+It is possible to defeat this protection using ' (tick) and <code>EXECUTE</code> though.
+
+
+<? entry("modifying the contents of the input buffer or a string literal (3.3.3.4 Text-literal regions, 3.3.3.5 Input buffers)") ?>+
+Varies depending on the nature of the buffer. The input buffer is supplied by ficl's host function, and may reside
+in read-only memory. If so, writing the input buffer can ganerate an exception.
+String literals are stored in the dictionary, and are writable.
+
+
+<? entry("overflow of a pictured numeric output string") ?>+
+In the unlikely event you are able to construct a pictured numeric string of more
+than <code>FICL_PAD_LENGTH</code> characters, the system will be corrupted unpredictably.
+The buffer area that holds pictured numeric output is at the end of the virtual machine.
+Whatever is mapped after the offending VM in memory will be trashed, along with the heap
+structures that contain it.
+
+
+<? entry("parsed string overflow") ?>+
+Ficl does not copy parsed strings unless asked to. Ordinarily, a string parsed from the input buffer during
+normal interpretation is left in-place, so there is no possibility of overflow.
+If you ask to parse a string into the dictionary, as in <code>SLITERAL</code>, you need to have enough
+room for the string, otherwise bad things may happen. This is usually not a problem.
+
+
+<? entry("producing a result out of range, e.g., multiplication (using *) results in a value too big to be represented by a single-cell integer (6.1.0090 *, 6.1.0100 */, 6.1.0110 */MOD, 6.1.0570, >NUMBER, 6.1.1561 FM/MOD, 6.1.2214 SM/REM, 6.1.2370 UM/MOD, 6.2.0970 CONVERT, 8.6.1.1820 M*/)") ?>+
+Value will be truncated.
+
+
+<? entry("reading from an empty data stack or return stack (stack underflow)") ?>+
+Most stack underflows are detected and prevented if <code>FICL_ROBUST</code> (defined in <code>sysdep.h</code>) is set to 2 or greater.
+Otherwise, the stack pointer and size are likely to be trashed.
+
+
+<? entry("unexpected end of input buffer, resulting in an attempt to use a zero-length string as a name") ?>+
+Ficl returns for a new input buffer until a non-empty one is supplied.
+
+
+</dl>
+
+
+The following specific ambiguous conditions are noted in the glossary entries of the relevant words:
+
+<dl>
+
+<? entry(">IN greater than size of input buffer (3.4.1 Parsing)") ?>+
+Memory corruption will occur—the exact behavior is unpredictable
+because the input buffer is supplied by the host program's outer loop.
+
+
+<? entry("6.1.2120 RECURSE appears after 6.1.1250 DOES>") ?>+
+It finds the address of the definition before <code>DOES></code>
+
+
+<? entry("argument input source different than current input source for 6.2.2148 RESTORE-INPUT") ?>+
+Not implemented.
+
+
+<? entry("data space containing definitions is de-allocated (3.3.3.2 Contiguous regions)") ?>+
+This is okay until the cells are overwritten with something else.
+The dictionary maintains a hash table, and the table must be updated
+in order to de-allocate words without corruption.
+
+
+<? entry("data space read/write with incorrect alignment (3.3.3.1 Address alignment)") ?>+
+Target processor dependent. Consequences include: none (Intel), address error exception (68K).
+
+
+<? entry("data-space pointer not properly aligned (6.1.0150 ,, 6.1.0860 C,)") ?>+
+See above on data space read/write alignment.
+
+<? entry("less than u+2 stack items (6.2.2030 PICK, 6.2.2150 ROLL)") ?>+
+If <code>FICL_ROBUST</code> is two or larger, Ficl will detect a stack underflow, report it, and execute <code>ABORT</code> to
+exit execution. Otherwise the error will not be detected, and memory corruption will occur.
+
+
+<? entry("loop-control parameters not available ( 6.1.0140 +LOOP, 6.1.1680 I, 6.1.1730 J, 6.1.1760 LEAVE, 6.1.1800 LOOP, 6.1.2380 UNLOOP)") ?>+
+Loop initiation words are responsible for checking the stack and guaranteeing that the control parameters are pushed.
+Any underflows will be detected early if <code>FICL_ROBUST</code> is set to 2 or greater.
+Note however that Ficl only checks for return stack underflows at the end of each line of text.
+
+<? entry("most recent definition does not have a name (6.1.1710 IMMEDIATE)") ?>+
+No problem.
+
+
+<? entry("name not defined by 6.2.2405 VALUE used by 6.2.2295 TO") ?>+
+Ficl's version of <code>TO</code> works correctly with words defined with:
+<ul>
+
+<li> <code>VALUE</code>
+<li> <code>2VALUE</code>
+<li> <code>FVALUE</code>
+<li> <code>F2VALUE</code>
+<li> <code>CONSTANT</code>
+<li> <code>FCONSTANT</code>
+<li> <code>2CONSTANT</code>
+<li> <code>F2CONSTANT</code>
+<li> <code>VARIABLE</code>
+<li> <code>2VARIABLE</code>
+</ul>
+as well as with all "local" variables.
+
+<? entry("name not found (6.1.0070 ', 6.1.2033 POSTPONE, 6.1.2510 ['], 6.2.2530 [COMPILE])") ?>+
+Ficl prints an error message and executes <code>ABORT</code>
+
+<? entry("parameters are not of the same type (6.1.1240 DO, 6.2.0620 ?DO, 6.2.2440 WITHIN)") ?>+
+Not detected. Results vary depending on the specific problem.
+
+
+<? entry("6.1.2033 POSTPONE or 6.2.2530 [COMPILE] applied to 6.2.2295 TO") ?>+
+The word is postponed correctly.
+
+
+<? entry("string longer than a counted string returned by 6.1.2450 WORD") ?>+
+Ficl stores the first <code>FICL_COUNTED_STRING_MAX</code> - 1 characters in the
+destination buffer.
+(The extra character is the trailing space required by the standard. Yuck.)
+
+<? entry("u greater than or equal to the number of bits in a cell (6.1.1805 LSHIFT, 6.1.2162 RSHIFT)") ?>+
+Depends on target process or and C runtime library implementations of the << and >> operators
+on unsigned values. For I386, the processor appears to shift modulo the number of bits in a cell.
+
+<? entry("word not defined via 6.1.1000 CREATE (6.1.0550 >BODY, 6.1.1250 DOES>)") ?>+
+<? entry("words improperly used outside 6.1.0490 <# and 6.1.0040 #> (6.1.0030 #, 6.1.0050 #S, 6.1.1670 HOLD, 6.1.2210 SIGN)") ?>+
+Undefined. <code>CREATE</code> reserves a field in words it builds for <code>DOES></code> to fill in.
+If you use <code>DOES></code> on a word not made by <code>CREATE</code> it will overwrite the first
+cell of its parameter area. That's probably not what you want. Likewise, pictured numeric words
+assume that there is a string under construction in the VM's scratch buffer. If that's not the case,
+results may be unpleasant.
+
+
+</dl>
+
+<? ficlHeader2("Locals Implementation-Defined Options") ?>+
+<dl>
+
+<? entry("maximum number of locals in a definition (13.3.3 Processing locals, 13.6.2.1795 LOCALS|)") ?>+
+Default is 64—unused locals are cheap. Change by redefining <code>FICL_MAX_LOCALS</code> (defined in <code>ficl.h</code>).
+
+</dl>
+
+
+<? ficlHeader2("Locals Ambiguous conditions") ?>+
+<dl>
+
+<? entry("executing a named local while in interpretation state (13.6.1.0086 (LOCAL))") ?>+
+Locals can be found in interpretation state while in the context of a definition under
+construction. Under these circumstances, locals behave correctly. Locals are not visible
+at all outside the scope of a definition.
+
+<? entry("name not defined by VALUE or LOCAL (13.6.1.2295 TO)") ?>+
+See the CORE ambiguous conditions, above (no change).
+
+</dl>
+
+
+<? ficlHeader2("Programming Tools Implementation-Defined Options") ?>+
+
+<dl>
+
+<? entry("source and format of display by 15.6.1.2194 SEE") ?>+
+<code>SEE</code> de-compiles definitions from the dictionary. Ficl words are stored as a combination
+of things:
+<ol>
+
+<li>bytecodes (identified as "instructions"),
+<li>addresses of native Ficl functions, and
+<li>arguments to both of the above.
+
+</ol>
+Colon definitions are decompiled. Branching instructions indicate their destination,
+but target labels are not reconstructed.
+Literals and string literals are so noted, and their contents displayed.
+
+</dl>
+
+
+<? ficlHeader2("Search Order Implementation-Defined Options") ?>+
+
+<dl>
+
+<? entry("maximum number of word lists in the search order (16.3.3 Finding definition names, 16.6.1.2197 SET-ORDER)") ?>+
+Defaults to 16. Can be changed by redefining <code>FICL_MAX_WORDLISTS</code> (declared in <code>ficl.h</code>).
+
+
+<? entry("minimum search order (16.6.1.2197 SET-ORDER, 16.6.2.1965 ONLY)") ?>+
+Equivalent to <code>FORTH-WORDLIST 1 SET-ORDER</code>
+
+</dl>
+
+
+
+<? ficlHeader2("Search Order Ambiguous Conditions") ?>+
+
+<dl>
+<? entry("changing the compilation word list (16.3.3 Finding definition names)") ?>+
+Ficl stores a link to the current definition independently of the compile wordlist while
+it is being defined, and links it into the compile wordlist only after the definition completes
+successfully. Changing the compile wordlist mid-definition will cause the definition to link
+into the <i>new</i> compile wordlist.
+
+
+<? entry("search order empty (16.6.2.2037 PREVIOUS)") ?>+
+Ficl prints an error message if the search order underflows, and resets the order to its default state.
+
+
+<? entry("too many word lists in search order (16.6.2.0715 ALSO)") ?>+
+Ficl prints an error message if the search order overflows, and resets the order to its default state.
+
+</dl>
+
+
+<? ficlPageFooter() ?>
--- /dev/null
+++ b/doc/source/ficl.ht
@@ -1,0 +1,1257 @@
+<!DOCTYPE html PUBLIC "-//w3c//dtd html 4.0 transitional//en">
+
+<html>
+<head>
+ <meta name="Author" content="john sadler">
+ <meta name="Description" content="Ficl - embedded scripting with object oriented programming">
+ <meta name="Keywords" content="scripting prototyping tcl OOP Forth interpreter C">
+ <link rel="SHORTCUT ICON" href="favicon.ico">
+ <title>Ficl - Embedded Scripting</title>
+</head>
+
+<body>
+
+<h1>Ficl Documentation</h1>
+
+<script language="javascript" src="ficlheader.js" type="text/javascript">
+</script>
+
+<h1><a name="whatis">What is Ficl?</a></h1>
+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. Unlike other
+scripting interpreters, Ficl:
+
+<ul>
+
+<li>
+typically takes under 2 hours to port to a new system—much
+less if the target operating system is one of several already supported
+(Win32, Linux, FreeBSD, RiscOS, and more)
+
+<li>
+has a small memory footprint: a fully featured Win32 console
+version takes less than 100K of memory, and a minimal version is less
+than half that
+
+<li>
+is relatively quick thanks to its "switch-threaded" virtual
+machine design and just in time compiling
+
+<li>
+is a complete and powerful programming language
+
+<li>
+is interactive
+
+<li>
+has object oriented programming features that can be used to wrap
+data structures or classes of the host system without altering them—even
+if the host is mainly written in a non-OO language
+
+</ul>
+
+<p>
+
+Ficl syntax is based on ANS Forth and the code is ANSI C. See
+below for examples of <a href="#includesficl">software and products
+that include ficl</a>. Ficl stands for "Forth inspired command language".
+
+
+<h3>Ficl Versus Other Forth Interpreters</h3>
+
+Where most Forths 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). In addition, Ficl provides a simple
+and powerful object model that can act as an object oriented <i>adapter</i>
+for code written in C (or asm, Forth, C++...).
+
+
+<h3>Ficl Design Goals</h3>
+<ul>
+
+<li>
+Target 32- and 64-bit processors
+
+<li>
+Scripting, prototyping, and extension language for systems
+written also in C
+
+<li>
+Supportable—code is as transparent as I can make it
+
+<li>
+Interface to functions written in C
+
+<li>
+Conformant to the 1994 ANSI Standard for Forth (DPANS94)
+
+<li>
+Minimize porting effort—require an ANSI C runtime environment
+and minimal glue code
+
+<li>
+Provide object oriented extensions
+
+</ul>
+
+<hr>
+
+<h2><a name="download">Download</a></h2>
+
+<ul>
+
+<li> <b><a href="http://sourceforge.net/project/showfiles.php?group_id=24441">Download Ficl (latest release)</a></b>
+
+</ul>
+
+<h2><a name="links">More information on Ficl and Forth</a></h2>
+
+<ul>
+
+<li>
+<a href="http://ficl.sourceforge.net">Web home of Ficl</a>
+
+<li>
+<a href="http://ficl.sourceforge.net/pdf/Forth_Primer.pdf">
+An excellent Forth Primer by Hans Bezemer
+</a>
+
+<li>
+<a href="ficlddj.pdf">
+Manuscript of Ficl article for January 1999 Dr. Dobb's Journal
+</a>
+
+<li>
+<a href="jwsforml.pdf">
+1998 FORML Conference paper—OO Programming in Ficl
+</a>
+
+<li>
+<a href="http://www.taygeta.com/forth_intro/stackflo.html">
+An Introduction to Forth using Stack Flow
+</a>
+(start here if you're new to Forth)
+
+<li>
+<a href="http://www.softsynth.com/pforth/pf_tut.htm">
+Phil Burk's Forth Tutorial
+</a>
+
+<li>
+<a href="http://www.complang.tuwien.ac.at/forth/threaded-code.html">
+Anton Ertl's description of Threaded Code
+</a>
+(Ficl now uses what he calls "switch threading")
+
+<li>
+<a href="http://ficl.sourceforge.net/dpans/dpans.htm">
+Draft Proposed American National Standard for Forth
+</a>
+(quite readable, actually)
+
+<li>
+<a href="http://www.taygeta.com/forthlit.html">
+Forth literature index on Taygeta
+</a>
+
+<li>
+<a href="http://www.forth.org">
+Forth Interest Group
+</a>
+
+</ul>
+
+<h2><a name="includesficl">Some software that uses Ficl</a></h2>
+
+<ul>
+<li>
+The <a href="http://www.freebsd.org/">FreeBSD</a> boot loader
+(Daniel Sobral, Jordan Hubbard)
+
+<li>
+<a href="http://www.chipcenter.com/networking/images/prod/prod158a.pdf">
+SwitchCore
+</a>
+Gigabit Ethernet switches (Örjan Gustavsson )
+
+<li>
+<a href="http://debuffer.sourceforge.net/">
+Palm Pilot Debuffer
+</a>
+(Eric Sessoms) Also see ficlx, a C++ interface to ficl, on the same site
+
+<li>
+<a href="http://www.swcp.com/%7Ejchavez/osmond.html">
+Osmond PC Board Layout tool
+</a>
+
+<li>
+<a href="http://www.netcomsystems.com">
+NetCom Systems
+</a>
+ML7710
+
+<li>
+<a href="http://www.parview.com/ds/homepage.html">
+ParView
+</a>
+GPS system
+
+<li>
+<a href="http://www.thekompany.com/products/powerplant/software/Languages/Embedded.php3">
+PowerPlant Software
+</a>
+Development Environment for Linux
+
+<li>
+<a href="http://www.vyyo.com/products/architecture_v3000.html">
+Vyyo V3000 Broadband Wireless Hub
+</a>
+
+<li>
+<a href="mailto:[email protected]">
+<i>Your Product Name Here!!!</i>
+</a>
+
+</ul>
+
+
+<hr>
+<h2><a name="lawyerbait">License And Disclaimer</a></h2>
+
+Copyright (c) 1997-2001 John Sadler ([email protected])
+<br>
+All rights reserved.
+<p>
+
+<b>
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+<ol>
+
+<li>
+Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+<li>
+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.
+
+</ol>
+
+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.
+</b>
+<p>
+
+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
+<a href="mailto:[email protected]">send me email</a>.
+<p>
+
+
+<h2><a name="features">Ficl Features</a></h2>
+
+<ul>
+
+<li>
+Simple to integrate into existing systems: the sample
+implementation requires three Ficl function calls (see the example
+program in <b>main.c</b>).
+
+<li>
+Written in ANSI C for portability.
+
+<li>
+Standard: Implements the ANS Forth CORE word set, part of the
+CORE EXT word set, SEARCH and SEARCH EXT, TOOLS and part of TOOLS EXT,
+LOCAL and LOCAL EXT, EXCEPTION, MEMORY, and various extras.
+
+<li>
+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 (not surprising if you're familiar with Forth)
+
+<li>
+Ficl and C/C++ can interact in two ways: Ficl can wrap C code,
+and C functions can invoke Ficl code.
+
+<li>
+Ficl code is thread safe and re-entrant: your program can have one or more
+Ficl "systems", and each "system" can have one or Ficl virtual machines.
+Each Ficl virtual machine has an otherwise complete state, and each can
+be bound to a separate I/O channel (or none at all).
+An optional function called ficlLockDictionary() can control
+exclusive dictionary access. This function is stubbed out by
+default (See FICL_MULTITHREAD in sysdep.h). As long as there is only
+one "session" that can compile words into the dictionary, you do not
+need exclusive dictionary access for multithreading.
+<b>Note</b>:
+while the code is re-entrant, there are still restrictions on how you
+can use it safely in a multithreaded system. Specifically, the VM
+itself maintains state, so you generally need a VM per thread in a
+multithreaded system. If interrupt service routines make calls into Ficl
+code that alters VM state, then these generally need their
+own VM as well. Alternatively, you could provide a mutual exclusion
+mechanism to serialize access to a VM from multiple threads.
+
+<li>
+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.
+
+<li>
+Written in ANSI C to be as simple as I can make it to understand,
+support, debug, and port. Compiles without complaint at <code>/Az /W4</code> (require
+ANSI C, max. warnings) under Microsoft Visual C++, and <code>-ansi</code>
+under GCC. Ports to several other toolchains and operating systems
+(notably FreeBSD and Linux flavors) exist.
+
+<li> Does full 32 bit math (but you need to implement two mixed
+precision math primitives (see sysdep.c)) </li>
+
+</ul>
+
+<hr>
+
+<h2><a name="porting">Porting Ficl</a></h2>
+
+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 <b>sysdep.h</tt> and <tt>sysdep.c</tt> and edit them to suit
+your system. For example, <tt>INT16</tt> is a <tt>short</tt> on some
+compilers and an <tt>int</tt> on others. Check the default <tt>CELL</tt>
+alignment controlled by <tt> FICL_ALIGN</tt>. If necessary, add new
+definitions of <tt>ficlMalloc, ficlFree, ficlRealloc</tt>, and <tt>ficlTextOut</tt>
+to work with your operating system. Finally, use <tt>testmain.c</tt> as
+a guide to installing the ficl system and one or more virtual machines
+into your code. You do not need to include <tt>testmain.c</tt> in your
+build.
+<p>
+Note: ficlLockDictionary can be left unimplemented in most
+multithreaded implementations - it's only necessary if you expect to
+have more than one thread modifying the dictionary at the same
+time. If you do decide to implement it, make sure calls to
+ficlLockDictionary can nest properly (see the comments in sysdep.h). You
+need to keep count of nested locks and unlocks and do the right
+thing.
+<p>
+
+Feel free to stub out the double precision math functions (which are
+presently implemented as inline assembly because it's so easy on many 32
+bit processors) with kludge code that only goes to 32 bit
+precision. In most applications, you won't notice the difference. If
+you're doing a lot of number crunching, consider implementing them
+correctly.
+
+
+<h3>Build Controls</h3>
+
+The file sysdep.h contains default values for build controls. Most of
+these are written such that if you define them on the compiler command
+line, the defaults are overridden. I suggest you take the defaults
+on everything below the "build controls" section until you're confident
+of your port. Beware of declaring too small a dictionary, for example.
+You need about 3200 cells for a full system, about 2000 if you
+strip out most of the "soft" words.
+
+<h3>Softcore</h3>
+Many words from all the supported wordsets are written in Forth, and
+stored as a big string that Ficl compiles when it starts. The sources
+for all of these words are in directory <b>softcore</b>. There is a
+.bat file (softcore.bat) and a PERL 5 script (softcore.pl) that convert
+Forth files into the file softcore.c, so softcore.c is really dependent
+on the Forth sources. This is not reflected in the Visual C++ project
+database. For the time being, it's a manual step. You can edit
+<b>make.bat</b> to change the list of files that contribute to
+<b>softcore.c</b>.
+
+<h3>To-Do List (target system dependent words)</h3>
+
+<ul>
+
+<li>
+Unimplemented system dependent <tt>CORE</tt> word: <tt>KEY</tt>
+(implement this yourself if you need it)
+
+<li>
+Kludged <tt>CORE</tt> word: <tt>ACCEPT</tt> (implement this
+better if you need to)
+
+</ul>
+
+<h2><a name="api">Application Programming Interface</a></h2>
+
+The following is a partial listing of functions that interface your
+system or program to Ficl. For a complete listing, see <b>ficl.h</b>
+(which is heavily commented). For examples, see <b>main.c</b> and the
+FiclWin sources (<a href="#download">below</a>).
+
+<dl>
+ <dt> <b>FICL_SYSTEM *ficlInitSystem(int nDictCells)</b> </dt>
+ <dd> Initializes Ficl's shared system data structures, and creates the
+dictionary allocating the specified number of CELLs from the heap (by a
+call to ficlMalloc) </dd>
+ <dt> <b>void ficlTermSystem(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Reclaims memory allocated for the ficl system including all
+dictionaries and all virtual machines created by vmCreate. Any uses of
+the memory allocation words (allocate and resize) are your
+problem. </dd>
+ <dt> <b>int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code,
+char flags)</b> </dt>
+ <dd> Create a primitive word in ficl's main dictionary with the given
+name, code pointer, and properties (immediate, compile only, etc) as
+described by the flags (see ficl.h for flag descriptions of
+the form FW_XXXX) </dd>
+ <dt> <b>int ficlExec(FICL_VM *pVM, char *text)</b> </dt>
+ <dd> Feed the specified C string ('\0' terminated) to the given+virtual machine for evaluation. Returns various exception codes (VM_XXXX
+in ficl.h) to indicate the reason for returning. Normal exit
+condition is VM_OUTOFTEXT, indicating that the VM consumed the string
+successfully and is back for more. ficlExec calls can be nested, and
+the function itself is re-entrant, but note that a VM is
+static, so you have to take reasonable precautions (for example, use one
+VM per thread in a multithreaded system if you want multiple threads to
+be able to execute commands). </dd>
+ <dt> <b>int ficlExecC(FICL_VM *pVM, char *text, int nChars)</b> </dt>
+ <dd> Same as ficlExec, but takes a count indicating the length of the
+supplied string. Setting nChars to -1 is equivalent to ficlExec (expects
+'\0' termination). </dd>
+ <dt> <b>int ficlExecXT(FICL_VM *pVM, FICL_WORD *pFW)</b> </dt>
+ <dd> Same as ficlExec, but takes a pointer to a FICL_WORD instead of a
+string. Executes the word and returns after it has finished. If
+executing the word results in an exception, this function will
+re-throw the same code if it is nested under another ficlExec family
+function, or return the exception code directly if not. This function
+is useful if you need to execute the same word repeatedly -
+you save the dictionary search and outer interpreter overhead. </dd>
+ <dt> <b>void ficlFreeVM(FICL_VM *pVM)</b> </dt>
+ <dd> 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. </dd>
+ <dt> <b>FICL_VM *ficlNewVM(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Create, initialize, and return a VM from the heap using
+ficlMalloc. Links the VM into the system VM list for later reclamation
+by ficlTermSystem. </dd>
+ <dt> <b>FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name)</b> </dt>
+ <dd> Returns the address (also known as an XT in this case) of the
+specified word in the main dictionary. If not found, returns NULL. The
+address can be used in a call to ficlExecXT. </dd>
+ <dt> <b>FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Returns a pointer to the main system dictionary, or NULL if the
+system is uninitialized. </dd>
+ <dt> <b>FICL_DICT *ficlGetEnv(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Returns a pointer to the environment dictionary. This dictionary
+stores information that describes this implementation as required by the
+Standard. </dd>
+ <dt> <b>void ficlSetEnv(FICL_SYSTEM *pSys, char *name, UNS32 value)</b> </dt>
+ <dd> Enters a new constant into the environment dictionary, with the
+specified name and value. </dd>
+ <dt> <b>void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, UNS32 hi,
+UNS32 lo)</b> </dt>
+ <dd> Enters a new double-cell constant into the environment dictionary
+with the specified name and value. </dd>
+ <dt> <b>FICL_DICT *ficlGetLoc(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Returns a pointer to the locals dictionary. This function is
+defined only if FICL_WANT_LOCALS is #defined as non-zero (see sysdep.h).
+The locals dictionary is the symbol table for <a href="ficl_loc.html">local
+variables</a>. </dd>
+ <dt> <b>void ficlCompileCore(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Defined in words.c, this function builds ficl's primitives.
+ </dd>
+ <dt> <b>void ficlCompileSoftCore(FICL_SYSTEM *pSys)</b> </dt>
+ <dd> Defined in softcore.c, this function builds ANS required words
+and ficl extras by evaluating a text string (think of it as a memory
+mapped file ;-) ). The string itself is built from files in
+the softwords directory by PERL script softcore.pl. </dd>
+</dl>
+<hr>
+<table border="0" cellspacing="5" cols="2">
+ <tbody>
+ <tr>
+ <td colspan="2">
+ <h2> <a name="manifest"></a>Ficl Source Files </h2>
+ </td>
+ </tr>
+ <tr>
+ <td> <b>ficl.h</b> </td>
+ <td> Declares most public functions and all data structures.
+Includes sysdep.h and math.h </td>
+ </tr>
+ <tr>
+ <td> <b>sysdep.h</b> </td>
+ <td> Declares system dependent functions and contains build
+control macros. Edit this file to port to another system. </td>
+ </tr>
+ <tr>
+ <td> <b>math.h</b> </td>
+ <td> Declares functions for 64 bit math </td>
+ </tr>
+ <tr>
+ <td> <b>dict.c</b> </td>
+ <td> Dictionary </td>
+ </tr>
+ <tr>
+ <td> <b>ficl.c</b> </td>
+ <td> System initialization, termination, and ficlExec </td>
+ </tr>
+ <tr>
+ <td> <b>float.c</b> </td>
+ <td> Adds precompiled definitions from the optional FLOAT word
+set. Most of the file is conditioned on FICL_WANT_FLOAT </td>
+ </tr>
+ <tr>
+ <td> <b>math64.c</b> </td>
+ <td> Implementation of 64 bit math words (except the two unsigned
+primitives declared in sysdep.h and implemented in sysdep.c) </td>
+ </tr>
+ <tr>
+ <td> <b>prefix.c</b> </td>
+ <td> The optional prefix parse step (conditioned on
+FICL_EXTENDED_PREFIX). This parse step handles numeric constructs like
+0xa100, for example. See the release notes for more on parse steps. </td>
+ </tr>
+ <tr>
+ <td> <b>search.c</b> </td>
+ <td> Contains C implementations of several of the SEARCH and
+SEARCH EXT words </td>
+ </tr>
+ <tr>
+ <td> <b>softcore.c</b> </td>
+ <td> Contains all of the "soft" words - those written in Forth and
+compiled by Ficl at startup time. Sources for these words are in the
+softwords directory. The files softwords/softcore.bat and
+softwords/softcore.pl generate softcore.c from the .fr sources. </td>
+ </tr>
+ <tr>
+ <td> <b>softwords/</b> </td>
+ <td> Directory contains sources and translation scripts for the
+words defined in softcore.c. Softcore.c depends on most of the files in
+this directory. See softcore.bat for the actual list of
+files that contribute to softcore.c. This is where you'll find source
+code for the object oriented extensions. PERL script softcore.pl
+converts the .fr files into softcore.c. </td>
+ </tr>
+ <tr>
+ <td> <b>stack.c</b> </td>
+ <td> Stack methods </td>
+ </tr>
+ <tr>
+ <td> <b>sysdep.c</b> </td>
+ <td> Implementation of system dependent functions declared in
+sysdep.h </td>
+ </tr>
+ <tr>
+ <td> <b>testmain.c</b> </td>
+ <td> The main() function for unix/linux/win32 console applications
+- use this as an example to integrate ficl into your system. Also
+contains some definitions for testing - also useful in
+unix/linux/win32 land. </td>
+ </tr>
+ <tr>
+ <td> <b>tools.c</b> </td>
+ <td> Contains C implementations of TOOLS and TOOLS EXT words, the
+debugger, and debugger support words. </td>
+ </tr>
+ <tr>
+ <td> <b>vm.c</b> </td>
+ <td> Virtual Machine methods </td>
+ </tr>
+ <tr>
+ <td> <b>win32.c & unix.c</b> </td>
+ <td> Platform extensions words loaded in ficl.c by
+ficlCompilePlatform() - conditioned on FICL_WANT_PLATFORM </td>
+ </tr>
+ <tr>
+ <td> <b>words.c</b> </td>
+ <td> Exports ficlCompileCore(), the run-time dictionary builder,
+and contains most precompiled CORE and CORE-EXT words. </td>
+ </tr>
+ </tbody>
+</table>
+<hr>
+<h2> <a name="extras"></a>Ficl extras </h2>
+<h3> <a name="exnumber"></a>Number syntax </h3>
+You can precede a number with "0x", as in C, and it will be interpreted
+as a hex value regardless of the value of <code>BASE</code>. Likewise,
+numbers prefixed with "0d" will be interpreted as decimal values.
+Example:
+<pre>ok> decimal 123 . cr<br>123<br>ok> 0x123 . cr<br>291<br>ok> 0x123 x. cr<br>123<br></pre>
+Note: ficl2.05 and later - this behavior is controlled by the <a
+ href="ficl_parse.html">prefix parser</a> defined in <code>prefix.c</code>.
+You can add other prefixes by defining handlers for them in ficl
+or C.
+<h3> <a name="exsearch"></a> The <code>SEARCH</code> wordset and Ficl
+extensions </h3>
+<p> Ficl implements many of the search order words in terms of two
+primitives called <code><a href="#tosearch">>SEARCH</a></code> and <code><a
+ href="#searchfrom">SEARCH></a></code>. As their names
+suggest (assuming you're familiar with Forth), they push and pop the
+search order stack. </p>
+<p> The standard does not appear to specify any conditions under which
+the search order is reset to a sane state. Ficl resets the search order
+to its default state whenever <tt>ABORT</tt> happens. This includes
+stack underflows and overflows. <tt>QUIT</tt> does not affect the search
+order. The minimum search order (set by <tt>ONLY</tt>) is equivalent
+to </p>
+<pre>FORTH-WORDLIST 1 SET-ORDER<br></pre>
+<p> There is a default maximum of 16 wordlists in the search order. This
+can be changed by redefining FICL_DEFAULT_VOCS (declared in sysdep.h). </p>
+<p> <b>Note</b>: Ficl resets the search order whenever it does <tt>ABORT</tt>.
+If you don't like this behavior, just comment out the
+dictResetSearchOrder() lines in ficlExec(). </p>
+<dl>
+ <dt> <a name="tosearch"></a><code>>search ( wid -- )</code> </dt>
+ <dd> Push <tt>wid</tt> onto the search order. Many of the other search
+order words are written in terms of the <tt>SEARCH></tt> and <tt>>SEARCH</tt>
+primitives. This word can be defined in ANS Forth as follows </dd>
+ <dd> <tt>: >search >r get-order 1+ r> swap
+set-order ;</tt> </dd>
+ <dt> <a name="searchfrom"></a><tt>search> ( -- wid )</tt> </dt>
+ <dd> Pop <tt>wid</tt> off the search order (can be coded in ANS Forth
+as <tt>: search> get-order nip 1- set-order ;</tt> ) </dd>
+ <dt> <a name="ficlsetcurrent"></a><tt>ficl-set-current (
+wid -- old-wid )</tt> </dt>
+ <dd> Set wid as compile wordlist, leaving the previous compile
+wordlist on the stack </dd>
+ <dt> <a name="ficlvocabulary"></a><tt>ficl-vocabulary (
+nBins "name" -- )</tt> </dt>
+ <dd> Creates a <tt>ficl-wordlist</tt> with the specified number of
+hash table bins, binds it to the name, and associates the semantics of <tt>vocabulary</tt>
+with it (replaces the top wid in the search order list with
+its own wid when executed) </dd>
+ <dt> <a name="ficlwordlist"></a><tt>ficl-wordlist ( nBins
+-- wid )</tt> </dt>
+ <dd> Creates a wordlist with the specified number of hash table bins,
+and leaves the address of the wordlist on the stack. A <tt>ficl-wordlist</tt>
+behaves exactly as a regular wordlist, but it may search
+faster depending on the number of bins chosen and the number of words it
+contains at search time. As implemented in ficl, a wordlist is single
+threaded by default. <tt> ficl-named-wordlist</tt> takes a name for the
+wordlist and creates a word that pushes the <tt>wid</tt>. This is by
+contrast to <tt>VOCABULARY</tt>, which also has a name, but replaces
+the top of the search order with its <tt>wid</tt>. </dd>
+ <dt> <a name="ficlforgetwid"></a><tt>forget-wid ( wid -- )</tt> </dt>
+ <dd> Iterates through the specified wordlist and unlinks all
+definitions whose xt addresses are greater than or equal to the value of <tt>HERE</tt>,
+the dictionary fill pointer. </dd>
+ <dt> <a name="ficlhide"></a><tt>hide ( -- current-wid-was
+)</tt> </dt>
+ <dd> Push the <tt>hidden</tt> wordlist onto the search order, and set
+it as the current compile wordlist (unsing <tt>ficl-set-current</tt>).
+Leaves the previous compile wordlist ID. I use this word to
+hide implementation factor words that have low reuse potential so that
+they don't clutter the default wordlist. To undo the effect of hide,
+execute <b><tt>previous set-current</tt></b> </dd>
+ <dt> <a name="ficlhidden"></a><tt>hidden ( -- wid )</tt> </dt>
+ <dd> Wordlist for storing implementation factors of ficl provided
+words. To see what's in there, try: <b><tt>hide words previous
+set-current</tt></b> </dd>
+ <dt> <a name="wid-get-name"></a><tt>wid-get-name ( wid --
+c-addr u )</tt> </dt>
+ <dd> Ficl wordlists (2.05 and later) have a name property that can be
+assigned. This is used by <tt>ORDER</tt> to list the names of wordlists
+in the search order. </dd>
+ <dt> <a name="wid-set-name"></a><tt>wid-set-name ( c-addr
+wid -- )</tt> </dt>
+ <dd> Ficl wordlists (2.05 and later) have a name property that can be
+assigned. This is used by <tt>ORDER</tt> to list the names of wordlists
+in the search order. The name is assumed to be a \0 terminated
+string (C style), which conveniently is how Ficl stores word
+names. See softwords/softcore.fr definition of <tt>brand-wordlist</tt> </dd>
+ <dt> <a name="wid-set-super"></a><tt>wid-set-super ( wid
+-- )</tt> </dt>
+ <dd> Ficl wordlists have a parent wordlist pointer that is not
+specified in standard Forth. Ficl initializes this pointer to NULL
+whenever it creates a wordlist, so it ordinarily has no effect.
+This word sets the parent pointer to the wordlist specified on the top
+of the stack. Ficl's implementation of <tt>SEARCH-WORDLIST</tt> will
+chain backward through the parent link of the wordlist when
+searching. This simplifies Ficl's object model in that the search order
+does not need to reflect an object's class hierarchy when searching for
+a method. It is possible to implement Ficl object syntax in
+strict ANS Forth, but method finders need to manipulate the search order
+explicitly. </dd>
+</dl>
+<h3> <a name="exuser"></a>User variables </h3>
+<dl>
+ <dt> <tt>user ( -- ) name</tt> </dt>
+ <dd> Create a user variable with the given name. User variables are
+virtual machine local. Each VM allocates a fixed amount of storage for
+them. You can change the maximum number of user variables
+allowed by defining FICL_USER_CELLS on your compiiler's command line.
+Default is 16 user cells. User variables behave like <tt>VARIABLE</tt>s
+in all other respects (you use @ and ! on them, for example).
+Example: </dd>
+ <dd>
+ <dl>
+ <dd> <tt>user current-class</tt> </dd>
+ <dd> <tt>0 current-class !</tt> </dd>
+ </dl>
+ </dd>
+</dl>
+<h3> <a name="exmisc"></a>Miscellaneous </h3>
+<dl>
+ <dt> <tt>-roll ( xu xu-1 ... x0 u -- x0 xu-1 ... x1
+) </tt> </dt>
+ <dd> Rotate u+1 items on top of the stack after removing u. Rotation
+is in the opposite sense to <tt>ROLL</tt> </dd>
+</dl>
+<dl>
+ <dt> <a name="minusrot"></a><tt>-rot ( a b c -- c a b )</tt> </dt>
+ <dd> Rotate the top three stack entries, moving the top of stack to
+third place. I like to think of this as <tt>1<sup>1</sup>/<sub>2</sub>swap</tt>
+because it's good for tucking a single cell value behind a
+cell-pair (like an object). </dd>
+</dl>
+<dl>
+ <dt> <tt>.env ( -- )</tt> </dt>
+ <dd> List all environment variables of the system </dd>
+ <dt> <tt>.hash ( -- )</tt> </dt>
+ <dd> List hash table performance statistics of the wordlist that's
+first in the search order </dd>
+ <dt> <tt>.ver ( -- )</tt> </dt>
+ <dd> Display ficl version ID </dd>
+ <dt> <tt>>name ( xt -- c-addr u )</tt> </dt>
+ <dd> Convert a word's execution token into the address and length of
+its name </dd>
+ <dt> <tt>body> ( a-addr -- xt )</tt> </dt>
+ <dd> Reverses the effect of <tt>CORE</tt> word <tt>>body</tt>
+(converts a parameter field address to an execution token) </dd>
+ <dt> <tt>compile-only</tt> </dt>
+ <dd> Mark the most recently defined word as being executable only
+while in compile state. Many <tt>immediate</tt> words have this
+property. </dd>
+ <dt> <tt>empty ( -- )</tt> </dt>
+ <dd> Empty the parameter stack </dd>
+ <dt> <tt>endif</tt> </dt>
+ <dd> Synonym for <tt>THEN</tt> </dd>
+ <dt> <a name="last-word"></a><tt>last-word ( -- xt )</tt> </dt>
+ <dd> Pushes the xt address of the most recently defined word. This
+applies to colon definitions, constants, variables, and words that use <tt>create</tt>.
+You can print the name of the most recently defined word
+with </dd>
+ <dd> <b><tt>last-word >name type</tt> </b> </dd>
+ <dt> <tt>parse-word ( <spaces>name -- c-addr u )</tt> </dt>
+ <dd> 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. (From the Standard) </dd>
+ <dt> <a name="qfetch"></a><tt>q@ ( addr -- x )</tt> </dt>
+ <dd> Fetch a 32 bit quantity from the specified address </dd>
+ <dt> <a name="qbang"></a><tt>q! ( x addr -- )</tt> </dt>
+ <dd> Store a 32 bit quantity to the specified address </dd>
+ <dt> <tt>w@ ( addr -- x )</tt> </dt>
+ <dd> Fetch a 16 bit quantity from the specified address </dd>
+ <dt> <tt>w! ( x addr -- )</tt> </dt>
+ <dd> Store a 16 bit quantity to the specified address (the low 16 bits
+of the given value) </dd>
+ <dt> <a name="xdot"></a><tt>x. ( x -- )</tt> </dt>
+ <dd> Pop and display the value in hex format, regardless of the
+current value of <tt>BASE</tt> </dd>
+</dl>
+<h3> <a name="exficlwin"></a>Extra words defined in testmain.c (Win32
+and POSIX versions) </h3>
+<dl>
+ <dt> <tt>break ( -- )</tt> </dt>
+ <dd> Does nothing - just a handy place to set a debugger breakpoint </dd>
+ <dt> <tt>cd (
+"directory-name<newline>" -- )</tt> </dt>
+ <dd> Executes the Win32 chdir() function, changing the program's
+logged directory. </dd>
+ <dt> <a name="clock"></a><tt>clock ( -- now )</tt> </dt>
+ <dd> Wrapper for the ANSI C clock() function. Returns the number of
+clock ticks elapsed since process start. </dd>
+ <dt> <a name="clockspersec"></a><tt>clocks/sec ( --
+clocks_per_sec )</tt> </dt>
+ <dd> Pushes the number of ticks in a second as returned by <tt>clock</tt> </dd>
+ <dt> <a name="ficlload"></a><tt>load (
+"filename<newline>" -- )</tt> </dt>
+ <dd> Opens the Forth source file specified and loads it one line at a
+time, like <tt>INCLUDED (FILE)</tt> </dd>
+ <dt> <tt>pwd ( -- )</tt> </dt>
+ <dd> Prints the current working directory as set by <tt>cd</tt> </dd>
+ <dt> <tt>system ( "command<newline>" -- )</tt> </dt>
+ <dd> Issues a command to a shell; implemented with the Win32 system()
+call. </dd>
+ <dt> <tt>spewhash ( "filename<newline>" -- )</tt> </dt>
+ <dd> Dumps all threads of the current compilation wordlist to the
+specified text file. This was useful when I thought there might be some
+point in attempting to optimize the hash function. I no longer
+harbor those illusions. </dd>
+</dl>
+<h3> Words defined in FiclWin only </h3>
+<dl>
+ <dt> <tt>!oreg ( c -- )</tt> </dt>
+ <dd> Set the value of the simulated LED register as specified (0..255)
+ </dd>
+ <dt> <tt>@ireg ( -- c )</tt> </dt>
+ <dd> Gets the value of the simulated switch block (0..255) </dd>
+ <dt> <tt>!dac ( c -- )</tt> </dt>
+ <dd> Sets the value of the bargraph control as specified. Valid values
+range from 0..255 </dd>
+ <dt> <tt>@adc ( -- c )</tt> </dt>
+ <dd> Fetches the current position of the slider control. Range is
+0..255 </dd>
+ <dt> <tt>status" ( "ccc<quote>" -- )</tt> </dt>
+ <dd> Set the mainframe window's status line to the text specified, up
+to the first trailing quote character. </dd>
+ <dt> <a name="ficlms"></a><tt><a
+ href="http://www.taygeta.com/forth/dpans10.htm#10.6.2.1905">ms</a>
+( u -- )</tt> </dt>
+ <dd> Causes the running virtual machine to sleep() for the number of
+milliseconds specified by the top-of-stack value. </dd>
+</dl>
+<hr>
+<h2> <a name="ansinfo"></a>ANS Required Information </h2>
+<b>ANS Forth System</b><br>
+<b>Providing names from the Core Extensions word set </b><br>
+<b>Providing the Exception word set</b><br>
+<b>Providing names from the Exception Extensions word set</b><br>
+<b>Providing the Locals word set </b><br>
+<b>Providing the Locals Extensions word set </b><br>
+<b>Providing the Memory Allocation word set</b><br>
+<b>Providing the Programming-Tools word set</b><br>
+<b>Providing names from the Programming-Tools Extensions word set</b><br>
+<b>Providing the Search-Order word set</b><br>
+<b>Providing the Search-Order Extensions word set</b>
+<h3> Implementation-defined Options </h3>
+The implementation-defined items in the following list represent
+characteristics and choices left to the discretion of the implementor,
+provided that the requirements of the Standard are met. A system
+shall document the values for, or behaviors of, each item.
+<ul>
+ <li> <b>aligned address requirements (3.1.3.3 Addresses);</b> </li>
+ <li> <br>
+ <font color="#000000">System dependent. You can change the default
+address alignment by defining FICL_ALIGN on your compiler's command
+line. The default value is set to 2 in sysdep.h. This causes
+dictionary entries and <tt>ALIGN</tt> and <tt>ALIGNED</tt> to align on 4
+byte boundaries. To align on <b>2<sup>n</sup></b> byte boundaries, set
+FICL_ALIGN to <b>n</b>. </font> </li>
+ <li> <b>behavior of 6.1.1320 EMIT for non-graphic characters</b>; </li>
+ <li> <br>
+ <font color="#000000">Depends on target system, C runtime library,
+and your implementation of ficlTextOut().</font> </li>
+ <li> <b>character editing of 6.1.0695 ACCEPT and 6.2.1390 EXPECT</b>; </li>
+ <li> <br>
+ <font color="#000000">None implemented in the versions supplied in
+words.c. Because ficlExec() is supplied a text buffer externally, it's
+up to your system to define how that buffer will be obtained.</font> </li>
+ <li> <b>character set (3.1.2 Character types, 6.1.1320 EMIT, 6.1.1750
+KEY)</b>; </li>
+ <li> <br>
+ <font color="#000000">Depends on target system and implementation
+of ficlTextOut()</font> </li>
+ <li> <b>character-aligned address requirements (3.1.3.3 Addresses)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl characters are one byte each. There are
+no alignment requirements.</font> </li>
+ <li> <b>character-set-extensions matching characteristics (3.4.2
+Finding definition n<font color="#000000">ames)</font></b><font
+ color="#000000">; </font> </li>
+ <li> <br>
+ <font color="#000000">No special processing is performed on
+characters beyond case-folding. Therefore, extended characters will not
+match their unaccented counterparts.</font> </li>
+ <li> <b>conditions under which control characters match a space
+delimiter (3.4.1.1 Delimiters)</b>;<font color="#ff6666"> </font> </li>
+ <li> <br>
+ <font color="#000000">Ficl uses the Standard C function isspace()
+to distinguish space characters. The rest is up to your library vendor.</font> </li>
+ <li> <b>format of the control-flow stack (3.2.3.2 Control-flow stack)</b>; </li>
+ <li> <br>
+ <font color="#000000">Uses the data stack</font> </li>
+ <li> <b>conversion of digits larger than thirty-five (3.2.1.2 Digit
+conversion)</b>; </li>
+ <li> <br>
+ <font color="#000000">The maximum supported value of <tt>BASE</tt>
+is 36. Ficl will assertion fail in function ltoa of vm.c if the base is
+found to be larger than 36 or smaller than 2. There will be no
+effect if NDEBUG is defined</font>, however, other than possibly
+unexpected behavior. </li>
+ <li> <b>display after input terminates in 6.1.0695 ACCEPT and
+6.2.1390 EXPECT</b>; </li>
+ <li> <br>
+ <font color="#000000">Target system dependent</font> </li>
+ <li> <b>exception abort sequence (as in 6.1.0680 ABORT")</b>; </li>
+ <li> <br>
+ <font color="#000000">Does <tt>ABORT</tt></font> </li>
+ <li> <b>input line terminator (3.2.4.1 User input device)</b>;<font
+ color="#ff0000"> </font> </li>
+ <li> <br>
+ <font color="#000000">Target system dependent (implementation of
+outer loop that calls ficlExec)</font> </li>
+ <li> <b>maximum size of a counted string, in characters (3.1.3.4
+Counted strings, 6.1.2450 WORD)</b>; </li>
+ <li> <br>
+ <font color="#000000">255</font> </li>
+ <li> <b>maximum size of a parsed string (3.4.1 Parsing)</b>; </li>
+ <li> <br>
+Limited by available memory and the maximum unsigned value that can fit
+in a CELL (2<sup>32</sup>-1). </li>
+ <li> <b>maximum size of a definition name, in characters (3.3.1.2
+Definition names)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl stores the first 31 characters of a
+definition name.</font> </li>
+ <li> <b>maximum string length for 6.1.1345 ENVIRONMENT?, in characters</b>; </li>
+ <li> <br>
+ <font color="#000000">Same as maximum definition name length</font> </li>
+ <li> <b>method of selecting 3.2.4.1 User input device</b>; </li>
+ <li> <br>
+None supported. This is up to the target system </li>
+ <li> <b>method of selecting 3.2.4.2 User output device</b>; </li>
+ <li> <br>
+None supported. This is up to the target system </li>
+ <li> <b>methods of dictionary compilation (3.3 The Forth dictionary)</b>; </li>
+ <li> <b>number of bits in one address unit (3.1.3.3 Addresses)</b>; </li>
+ <li> <br>
+ <font color="#000000">Target system dependent. Ficl generally
+supports processors that can address 8 bit quantities, but there is no
+dependency that I'm aware of.</font> </li>
+ <li> <b>number representation and arithmetic (3.2.1.1 Internal number
+representation)</b>; </li>
+ <li> <br>
+System dependent. Ficl represents a CELL internally as a union that can
+hold INT32 (a signed 32 bit scalar value), UNS32 (32 bits unsigned), and
+an untyped pointer. No specific byte ordering is
+assumed. </li>
+ <li> <b>ranges for n, +n, u, d, +d, and ud (3.1.3 Single-cell types,
+3.1.4 Cell-pair types)</b>; </li>
+ <li> <br>
+Assuming a 32 bit implementation, range for signed single-cell values
+is -2<sup>31</sup>..2<sup>31</sup>-1. Range for unsigned single cell
+values is 0..2<sup>32</sup>-1. Range for signed double-cell
+values is -2<sup>63</sup>..2<sup>63</sup>-1. Range for unsigned single
+cell values is 0..2<sup>64</sup>-1. </li>
+ <li> <b>read-only data-space regions (3.3.3 Data space)</b>; </li>
+ <li> <br>
+None </li>
+ <li> <b>size of buffer at 6.1.2450 WORD (3.3.3.6 Other transient
+regions)</b>; </li>
+ <li> <br>
+Default is 255. Depends on the setting of nPAD in ficl.h. </li>
+ <li> <b>size of one cell in address units (3.1.3 Single-cell types)</b>; </li>
+ <li> <br>
+ <font color="#000000">System dependent, generally four.</font> </li>
+ <li> <b>size of one character in address units (3.1.2 Character types)</b>; </li>
+ <li> <br>
+ <font color="#000000">System dependent, generally one.</font> </li>
+ <li> <b>size of the keyboard terminal input buffer (3.3.3.5 Input
+buffers)</b>; </li>
+ <li> <br>
+ <font color="#000000">This buffer is supplied by the host program.
+Ficl imposes no practical limit.</font> </li>
+ <li> <b>size of the pictured numeric output string buffer (3.3.3.6
+Other transient regions)</b>; </li>
+ <li> <br>
+Default is 255 characters. Depends on the setting of nPAD in
+ficl.h. </li>
+ <li> <b>size of the scratch area whose address is returned by
+6.2.2000 PAD (3.3.3.6 Other transient regions)</b>; </li>
+ <li> <br>
+Not presently supported </li>
+ <li> <b>system case-sensitivity characteristics (3.4.2 Finding
+definition names)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl is not case sensitive</font> </li>
+ <li> <b>system prompt (3.4 The Forth text interpreter, 6.1.2050 QUIT)</b>; </li>
+ <li> <br>
+ <font color="#000000">"ok>"</font> </li>
+ <li> <b>type of division rounding (3.2.2.1 Integer division, 6.1.0100
+*/, 6.1.0110 */MOD, 6.1.0230 /, 6.1.0240 /MOD, 6.1.1890 MOD)</b>; </li>
+ <li> <br>
+ <font color="#000000">Symmetric</font> </li>
+ <li> <b>values of 6.1.2250 STATE when true</b>; </li>
+ <li> <br>
+ <font color="#000000">One (no others)</font> </li>
+ <li> <b>values returned after arithmetic overflow (3.2.2.2 Other
+integer operations)</b>; </li>
+ <li> <br>
+System dependent. Ficl makes no special checks for overflow. </li>
+ <li> <b>whether the current definition can be found after 6.1.1250
+DOES> (6.1.0450 :)</b>. </li>
+ <li> <br>
+ <font color="#000000">No. Definitions are unsmudged after ; only,
+and only then if no control structure matching problems have been
+detected.</font> </li>
+</ul>
+<h3> Ambiguous Conditions </h3>
+A system shall document the system action taken upon each of the
+general or specific ambiguous conditions identified in this Standard.
+See 3.4.4 Possible actions on an ambiguous condition.
+<p> The following general ambiguous conditions could occur because of a
+combination of factors: </p>
+<ul>
+ <li> <b>a name is neither a valid definition name nor a valid number
+during text interpretation (3.4 The Forth text interpreter)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl does <tt>ABORT</tt> and prints the name
+followed by " not found".</font> </li>
+ <li> <b>a definition name exceeded the maximum length allowed
+(3.3.1.2 Definition names)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl stores the first 31 characters of the
+definition name, and uses all characters of the name in computing its
+hash code. The actual length of the name, up to 255
+characters, is stored in the definition's length field.</font> </li>
+ <li> <b>addressing a region not listed in 3.3.3 Data Space</b>;
+ </li>
+ <li> <br>
+ <font color="#000000">No problem: all addresses in ficl are
+absolute. You can reach any 32 bit address in Ficl's address space.</font> </li>
+ <li> <b>argument type incompatible with specified input parameter,
+e.g., passing a flag to a word expecting an n (3.1 Data types)</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl makes no check for argument type
+compatibility. Effects of a mismatch vary widely depending on the
+specific problem and operands.</font> </li>
+ <li> <b>attempting to obtain the execution token, (e.g., with
+6.1.0070 ', 6.1.1550 FIND, etc.) of a definition with undefined
+interpretation semantics</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl returns a valid token, but the result of
+executing that token while interpreting may be undesirable.</font> </li>
+ <li> <b>dividing by zero (6.1.0100 */, 6.1.0110 */MOD, 6.1.0230 /,
+6.1.0240 /MOD, 6.1.1561 FM/MOD, 6.1.1890 MOD, 6.1.2214 SM/REM, 6.1.2370
+UM/MOD, 8.6.1.1820 M*/)</b>; </li>
+ <li> <br>
+ <font color="#000000">Results are target procesor dependent.
+Generally, Ficl makes no check for divide-by-zero. The target processor
+will probably throw an exception.</font> </li>
+ <li> <b>insufficient data-stack space or return-stack space (stack
+overflow)</b>; </li>
+ <li> <br>
+ <font color="#000000">With FICL_ROBUST (sysdep.h) set >= 2, most
+parameter stack operations are checked for underflow and overflow. Ficl
+does not check the return stack.</font> </li>
+ <li> <b>insufficient space for loop-control parameters</b>; </li>
+ <li> <br>
+ <font color="#000000">No check - Evil results.</font> </li>
+ <li> <b>insufficient space in the dictionary</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl generates an error message if the
+dictionary is too full to create a definition header. It checks <tt>ALLOT</tt>
+as well, but it is possible to make an unchecked allocation
+request that overflows the dictionary.</font> </li>
+ <li> <b>interpreting a word with undefined interpretation semantics</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl protects all ANS Forth words with
+undefined interpretation semantics from being executed while in
+interpret state. It is possible to defeat this protection using
+' (tick) and <tt>EXECUTE</tt>, though.</font> </li>
+ <li> <b>modifying the contents of the input buffer or a string
+literal (3.3.3.4 Text-literal regions, 3.3.3.5 Input buffers)</b>; </li>
+ <li> <br>
+ <font color="#000000">Varies depending on the nature of the buffer.
+The input buffer is supplied by ficl's host function, and may reside in
+read-only memory. If so, writing the input buffer can ganerate
+an exception. String literals are stored in the dictionary, and are
+writable.</font> </li>
+ <li> <b>overflow of a pictured numeric output string</b>; </li>
+ <li> <br>
+In the unlikely event you are able to construct a pictured numeric
+string of more than 255 characters, the system will be corrupted
+unpredictably. The buffer area that holds pictured numeric
+output is at the end of the virtual machine. Whatever is mapped after
+the offending VM in memory will be trashed, along with the heap
+structures that contain it. </li>
+ <li> <b>parsed string overflow</b>; </li>
+ <li> <br>
+Ficl does not copy parsed strings unless asked to. Ordinarily, a string
+parsed from the input buffer during normal interpretation is left
+in-place, so there is no possibility of overflow. If you ask
+to parse a string into the dictionary, as in <tt>SLITERAL</tt>, you
+need to have enough room for the string, otherwise bad things may
+happen. This is not usually a problem. </li>
+ <li> <b>producing a result out of range, e.g., multiplication (using
+*) results in a value too big to be represented by a single-cell integer
+(6.1.0090 *, 6.1.0100 */, 6.1.0110 */MOD, 6.1.0570
+>NUMBER, 6.1.1561 FM/MOD, 6.1.2214 SM/REM, 6.1.2370 UM/MOD, 6.2.0970
+CONVERT, 8.6.1.1820 M*/)</b>; </li>
+ <li> <br>
+ <font color="#000000">Value will be truncated</font> </li>
+ <li> <b>reading from an empty data stack or return stack (stack
+underflow)</b>; </li>
+ <li> <br>
+ <font color="#000000">Most stack underflows are detected and
+prevented if FICL_ROBUST (sysdep.h) is set to 2 or greater. Otherwise,
+the stack pointer and size are likely to be trashed.</font> </li>
+ <li> <b>unexpected end of input buffer, resulting in an attempt to
+use a zero-length string as a name</b>; </li>
+ <li> <br>
+ <font color="#000000">Ficl returns for a new input buffer until a
+non-empty one is supplied.</font> </li>
+</ul>
+The following specific ambiguous conditions are noted in the glossary
+entries of the relevant words:
+<ul>
+ <li> <b>>IN greater than size of input buffer (3.4.1 Parsing)</b> </li>
+ <li> <br>
+Bad Things occur - unpredictable bacause the input buffer is supplied
+by the host program's outer loop. </li>
+ <li> <b>6.1.2120 RECURSE appears after 6.1.1250 DOES></b> </li>
+ <li> <br>
+It finds the address of the definition before <tt>DOES></tt> </li>
+ <li> <b>argument input source different than current input source for
+6.2.2148 RESTORE-INPUT</b> </li>
+ <li> <br>
+Not implemented </li>
+ <li> <b>data space containing definitions is de-allocated (3.3.3.2
+Contiguous regions)</b> </li>
+ <li> <br>
+This is OK until the cells are overwritten with something else. The
+dictionary maintains a hash table, and the table must be updated in
+order to de-allocate words without corruption. </li>
+ <li> <b>data space read/write with incorrect alignment (3.3.3.1
+Address alignment)</b> </li>
+ <li> <br>
+Target processor dependent. Consequences include: none (Intel), address
+error exception (68K). </li>
+ <li> <b>data-space pointer not properly aligned (6.1.0150 ,, 6.1.0860
+C,)</b> </li>
+ <li> <br>
+See above on data space read/write alignment </li>
+ <li> <b>less than u+2 stack items (6.2.2030 PICK, 6.2.2150 ROLL)</b> </li>
+ <li> <br>
+Ficl detects a stack underflow and reports it, executing <tt>ABORT,</tt>
+as long as FICL_ROBUST is two or larger. </li>
+ <li> <b>loop-control parameters not available ( 6.1.0140 +LOOP,
+6.1.1680 I, 6.1.1730 J, 6.1.1760 LEAVE, 6.1.1800 LOOP, 6.1.2380 UNLOOP)</b> </li>
+ <li> <br>
+Loop initiation words are responsible for checking the stack and
+guaranteeing that the control parameters are pushed. Any underflows will
+be detected early if FICL_ROBUST is set to two or greater.
+Note however that Ficl only checks for return stack underflows at the
+end of each line of text. </li>
+ <li> <b>most recent definition does not have a name (6.1.1710
+IMMEDIATE)</b> </li>
+ <li> <br>
+No problem. </li>
+ <li> <b>name not defined by 6.2.2405 VALUE used by 6.2.2295 TO</b> </li>
+ <li> <br>
+Ficl's version of <tt>TO</tt> works correctly with <tt>VALUE</tt>s, <tt>CONSTANT</tt>s
+and <tt>VARIABLE</tt>s. </li>
+ <li> <b>name not found (6.1.0070 ', 6.1.2033 POSTPONE, 6.1.2510 ['],
+6.2.2530 [COMPILE])</b> </li>
+ <li> <br>
+Ficl prints an error message and does <tt>ABORT</tt> </li>
+ <li> <b>parameters are not of the same type (6.1.1240 DO, 6.2.0620
+?DO, 6.2.2440 WITHIN)</b> </li>
+ <li> <br>
+No check. Results vary depending on the specific problem. </li>
+ <li> <b>6.1.2033 POSTPONE or 6.2.2530 [COMPILE] applied to 6.2.2295 TO</b> </li>
+ <li> <br>
+The word is postponed correctly. </li>
+ <li> <b>string longer than a counted string returned by 6.1.2450 WORD</b> </li>
+ <li> <br>
+Ficl stores the first FICL_STRING_MAX-1 chars in the destination
+buffer. (The extra character is the trailing space required by the
+standard. Yuck.) </li>
+ <li> <b>u greater than or equal to the number of bits in a cell
+(6.1.1805 LSHIFT, 6.1.2162 RSHIFT)</b> </li>
+ <li> <br>
+Depends on target process or and C runtime library implementations of
+the << and >> operators on unsigned values. For I386, the
+processor appears to shift modulo the number of bits in a
+cell. </li>
+ <li> <b>word not defined via 6.1.1000 CREATE (6.1.0550 >BODY,
+6.1.1250 DOES>)</b> </li>
+ <li> <br>
+ <b>words improperly used outside 6.1.0490 <# and 6.1.0040 #>
+(6.1.0030 #, 6.1.0050 #S, 6.1.1670 HOLD, 6.1.2210 SIGN)</b><br>
+Don't. <tt>CREATE</tt> reserves a field in words it builds for <tt>DOES></tt>to
+fill in. If you use <tt>DOES></tt> on a word not made by <tt>CREATE</tt>,
+it will overwrite the first cell of its parameter area.
+That's probably not what you want. Likewise, pictured numeric words
+assume that there is a string under construction in the VM's scratch
+buffer. If that's not the case, results may be unpleasant. </li>
+</ul>
+<h3> Locals Implementation-defined options </h3>
+<ul>
+ <li> <b>maximum number of locals in a definition (13.3.3 Processing
+locals, 13.6.2.1795 LOCALS|)</b> </li>
+ <li> <br>
+Default is 16. Change by redefining FICL_MAX_LOCALS, defined in
+sysdep.h </li>
+</ul>
+<h3> Locals Ambiguous conditions </h3>
+<ul>
+ <li> <b>executing a named local while in interpretation state
+(13.6.1.0086 (LOCAL))</b> </li>
+ <li> <br>
+Locals can be found in interpretation state while in the context of a
+definition under construction. Under these circumstances, locals behave
+correctly. Locals are not visible at all outside the scope of
+a definition. </li>
+ <li> <b>name not defined by VALUE or LOCAL (13.6.1.2295 TO)</b> </li>
+ <li> <br>
+See the CORE ambiguous conditions, above (no change) </li>
+</ul>
+<h3> Programming Tools Implementation-defined options </h3>
+<ul>
+ <li> <b>source and format of display by 15.6.1.2194 SEE</b> </li>
+ <li> <br>
+SEE de-compiles definitions from the dictionary. Because Ficl words are
+threaded by their header addresses, it is very straightforward to print
+the name and other characteristics of words in a definition.
+Primitives are so noted. Colon definitions are decompiled, but branch
+target labels are not reconstructed. Literals and string literals are so
+noted, and their contents displayed. </li>
+</ul>
+<h3> Search Order Implementation-defined options </h3>
+<ul>
+ <li> <b>maximum number of word lists in the search order (16.3.3
+Finding definition names, 16.6.1.2197 SET-ORDER)</b> </li>
+ <li> <br>
+Defaults to 16. Can be changed by redefining FICL_DEFAULT_VOCS,
+declared in sysdep.h </li>
+ <li> <b>minimum search order (16.6.1.2197 SET-ORDER, 16.6.2.1965 ONLY)</b> </li>
+ <li> <br>
+Equivalent to <tt>FORTH-WORDLIST 1 SET-ORDER</tt> </li>
+</ul>
+<h3> Search Order Ambiguous conditions </h3>
+<ul>
+ <li> <b>changing the compilation word list (16.3.3 Finding definition
+names)</b> </li>
+ <li> <br>
+Ficl stores a link to the current definition independently of the
+compile wordlist while it is being defined, and links it into the
+compile wordlist only after the definition completes
+successfully. Changing the compile wordlist mid-definition will cause
+the definition to link into the <i>new</i> compile wordlist. </li>
+ <li> <b>search order empty (16.6.2.2037 PREVIOUS)</b> </li>
+ <li> <br>
+Ficl prints an error message if the search order underflows, and resets
+the order to its default state. </li>
+ <li> <b>too many word lists in search order (16.6.2.0715 ALSO)</b> </li>
+ <li> <br>
+Ficl prints an error message if the search order overflows, and resets
+the order to its default state. </li>
+</ul>
+</div>
+</body>
+</html>
--- /dev/null
+++ b/doc/source/generate.py
@@ -1,0 +1,244 @@
+import cStringIO
+import os
+import re
+import shutil
+import string
+import sys
+
+
+outputStart = None
+navBarEntries = {}+
+
+
+def ficlLinkEntry(file, title):
+ print("<a href=" + file + ".html><font color=white>" + title + "</font></a><p>\n")+
+
+
+currentNavBarName = None
+
+def ficlAddToNavBarAs(name):
+ global currentNavBarName
+ currentNavBarName = name
+
+
+def ficlPageHeader(heading):
+ outputStart.write("""<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>""" + heading + """</TITLE>
+<style>\n
+blockquote { margin-left: 1em }\n+</style>\n
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>\n
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+""" + heading + """
+</i></b></font>
+</td></tr>
+
+\n<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+""")
+
+ print("</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>\n")+
+
+
+def ficlPageFooter():
+ print("\n</blockquote><p></td></tr></table></body></html>\n")+
+
+
+sizeArray = [7, 5, 4, 3, 2]
+indentLevel = 0
+sections = None
+
+def ficlHeader(level, color, bgcolor, heading):
+ global sizeArray
+ size = str(sizeArray[level])
+
+ global indentLevel
+ global sections
+ while (indentLevel < level):
+ indentLevel += 1
+# sys.stderr.write("adding 1 to indentLevel, it's now " + str(indentLevel) + "\n\n")+ sections.append([])
+ while (indentLevel > level):
+ indentLevel -= 1
+ subheadings = sections.pop()
+# sys.stderr.write("indentLevel is " + str(indentLevel) + ", subheadings is " + str(subheadings) + ", len(sections) is " + str(len(sections)) + ", sections is " + str(sections) + "\n\n")+ sections[indentLevel - 1][-1][1] = subheadings
+ entry = [heading, [] ]
+# sys.stderr.write("indentLevel is " + str(indentLevel) + ", len(sections) is " + str(len(sections)) + ", sections is " + str(sections) + "\n\n")+# sys.stderr.flush()
+ sections[indentLevel - 1].append(entry)
+
+ print("""+<p>
+</blockquote><table border=0 bgcolor=""" + bgcolor + """ width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=""" + color + " size=" + size + "><b><i>")
+ print("<a name='" + collapse(heading) + "'>")+ print(heading)
+ print("</a></i></b></font></td></tr></table><p><blockquote>\n")+
+
+def ficlHeader1(heading):
+ ficlHeader(1, "#004968", "#a0a0a0", heading)
+
+def ficlHeader2(heading):
+ ficlHeader(2, "#004968", "#b8b8b8", heading)
+
+def ficlHeader3(heading):
+ ficlHeader(3, "#004968", "#d0d0d0", heading)
+
+def ficlHeader4(heading):
+ ficlHeader(4, "#004968", "#e8e8e8", heading)
+
+
+def collapse(s):
+ return string.join(s.split(), "").replace("'", "").replace("&", "").replace('"', "").replace('<', "").replace('>', "").replace('.', "").replace('?', "")+
+def dump(f, sections):
+ for section in sections:
+ sys.stderr.write("sections is " + str(section) + "\n")+ name = section[0]
+ f.write("<li><a href=#" + collapse(name) + "><font color=white>" + name + "</font></a>\n")+ if len(section[1]) != 0:
+ f.write("<ul>\n")+ dump(f, section[1])
+ f.write("</ul>\n")+
+def process(inputfilename, outputfilename):
+ print "generating " + inputfilename
+ global indentLevel
+ indentLevel = 0
+ global sections
+ sections = []
+ global currentNavBarName
+
+ input = open(inputfilename, "r")
+ data = input.read().replace("\r", "")+ input.close()
+ chunks = data.split("<?")+
+ output = cStringIO.StringIO()
+
+ global outputStart
+ outputStart = cStringIO.StringIO()
+
+ stdout = sys.stdout
+
+ fauxGlobals = { }+ fauxGlobals.update(globals())
+ fauxGlobals['__name__'] = '__ficlDocs__'
+ fauxGlobals['__doc__'] = inputfilename
+ fauxGlobals['outputStart'] = outputStart
+
+ sys.stdout = output
+ if (chunks[0] != None):
+ output.write(chunks[0])
+ for chunk in chunks[1:]:
+ (code, verbatim) = chunk.split("?>")+ code = code.lstrip()
+ if (code[0] == "="):
+ execution = "eval"
+ code = code[1:].lstrip()
+ else:
+ execution = "exec"
+ compiled = compile(code, "[unknown]", execution)
+ if (execution == "eval"):
+ output.write(str(eval(compiled)))
+ else:
+ exec compiled
+ output.write(verbatim)
+
+ sys.stdout = stdout
+
+
+ f = open(outputfilename, "w")
+ f.write(outputStart.getvalue())
+ f.write("<p><br>\n")+ keys = navBarEntries.keys()
+ keys.sort()
+ for name in keys:
+ filename = navBarEntries[name]
+ f.write("<a href=" + filename + ">")+ name = name.replace(" ", " ")+ f.write("<font face=arial,helvetica color=white><b>" + name + "</b></font>")+ f.write("</a><br>\n")+# This doesn't look as pretty as I wanted, so I'm turning it off. --lch
+# if (name == currentNavBarName) and (len(sections) > 0):
+# f.write("<ul>\n")+# dump(f, sections[0])
+# f.write("</ul>\n")+
+ f.write(output.getvalue())
+ f.close()
+
+
+
+##
+## First, find all the documents in the current directory,
+## and look for their navBar entry.
+##
+
+for filename in os.listdir("."):+ if filename[-3:] == ".ht":
+ file = open(filename, "rb")
+ for line in file.readlines():
+ navBar = "ficlAddToNavBarAs(\""
+ if line.strip().startswith(navBar):
+ (a, name, b) = line.split('"')+ navBarEntries[name] = filename + "ml"
+ break
+ file.close()
+
+navBarEntries["Download"] = "http://sourceforge.net/project/showfiles.php?group_id=24441"
+
+ignored = re.compile("^((.*\.pyc?)|(.*\.zip)|\.|(\.\.))$")+
+##
+## Second, build the doc tree (in ..), processing as necessary.
+##
+def visit(unused, directory, names):
+ for file in names:
+ if ignored.search(file):
+ continue
+ input = directory + "/" + file
+ output = "../" + input
+ if input[-3:].lower() == ".ht":
+ process(input, output + "ml")
+ elif os.path.isdir(input):
+ if not os.path.isdir(output):
+ os.mkdir(output)
+ else:
+ try:
+ shutil.copy2(input, output)
+ except IOError:
+ ## Ignore file-copy errors. It's probably
+ ## a read-only file that doesn't change.
+ ## Lazy, I know. --lch
+ None
+
+os.path.walk(".", visit, None)+
+
--- /dev/null
+++ b/doc/source/index.ht
@@ -1,0 +1,244 @@
+<?
+ficlPageHeader("ficl")+
+def feature(preamble, keyfeature, postscript = ""):
+ print "<p><dt>\n" + preamble + " <b><i>" + keyfeature + "</i></b> " + postscript + "\n<dd>\n"
+
+?>
+
+
+<? ficlHeader1("What is Ficl?") ?>+
+
+Ficl is a programming language interpreter designed to be embedded
+into other systems as a command, macro, and development prototyping
+language.
+<p>
+
+Ficl is an acronym for "Forth Inspired Command Language".
+
+
+<? ficlHeader1("Ficl Features") ?>+
+<dl>
+
+
+<? feature("Ficl is", "easy to port.") ?>+
+<ul>
+
+<li>
+It typically takes under 2 hours to port to a new platform.
+
+<li>
+Ficl is written in strict ANSI C.
+
+<li>
+Ficl can run natively on 32- and 64-bit processors.
+
+</ul>
+
+
+
+<? feature("Ficl has a", "small memory footprint.") ?>+
+A fully featured Win32 console version takes less than 100K
+of memory, and a minimal version is less
+than half that.
+
+
+
+<? feature("Ficl is ", "easy to integrate", "into your program.") ?>+
+Where most Forths 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 your program. 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.
+
+
+
+<? feature("Ficl is", "fast.") ?>+
+Thanks to its
+<a href=http://www.complang.tuwien.ac.at/forth/threaded-code.html#switch-threading>"switch-threaded"</a>
+virtual machine design, Ficl 4 is faster than ever—about 3x the speed of Ficl 3.
+Ficl also features blindingly fast "just in time" compiling, removing the "compile" step from
+the usual compile-debug-edit iterative debugging cycle.
+
+
+
+<? feature("Ficl is a", "complete and powerful programming language.") ?>+
+Ficl is an implementation of the FORTH language, a language providing
+a wide range of standard programming language features:
+<ul>
+
+<li>
+Integer and floating-point numbers, with a rich set of operators.
+
+<li>
+Arrays.
+
+<li>
+File I/O.
+
+<li>
+Flow control (<code>if/then/else</code> and many looping structures).
+
+<li>
+Subroutines with named arguments.
+
+<li>
+Language extensibility.
+
+<li>
+Powerful code pre-processing features.
+
+</ul>
+
+
+
+<? feature("Ficl is ", "standards-compliant.") ?>+
+Ficl conforms to the 1994 ANSI Standard for FORTH (DPANS94).
+See <a href=dpans.html>ANS Required Information</a> for
+more detail.
+
+
+<? feature("Ficl is", "extensible.") ?>+
+Ficl is extensible both at compile-time and at run-time.
+You can add new script functions, new native functions,
+even new control structures.
+
+
+
+
+<? feature("Ficl adds ", "object oriented programming features.") ?>+
+Ficl's flexible OOP library can be used to wrap
+data structures or classes of the host system without altering them.
+(And remember how we said Ficl was extensible? Ficl's object-oriented
+programming extensions are written in Ficl.)
+
+
+
+<? feature("Ficl is", "interactive.") ?>+
+Ficl can be used interactively, like most other FORTHs, Python,
+and Smalltalk. You can inspect data, run commands, or even
+define new commands, all on a running Ficl VM.
+Ficl also has a built-in script debugger that allows you to
+step through Ficl code as it is executed.
+
+
+<? feature("Ficl is", "ROMable.") ?>+
+Ficl is designed to work in RAM based and ROM code / RAM
+data environments.
+
+
+
+<? feature("Ficl is", "safe for multithreaded programs.") ?>+
+Ficl is reentrant and thread-safe. After initialization,
+it does not write to any global data.
+
+
+<? feature("Ficl is ", "open-source and free.") ?>+
+The <a href=license.html>Ficl licence</a> is a BSD-style
+license, requiring only that you document that you are
+using Ficl. There are no licensing costs for using Ficl.
+
+
+</dl>
+
+
+<a name=whatsnew>
+<? ficlHeader1("What's New In Ficl 4.0?") ?>+</a>
+
+Ficl 4.0 is a major change for Ficl. Ficl 4.0 is <i>smaller</i>,
+<i>faster</i>, <i>more powerful</i>, and <i>easier to use</i>
+than ever before. (Or your money back!)
+<p>
+
+Ficl 4.0 features a major engine rewrite. Previous versions
+of Ficl stored compiled words as an array of pointers to data
+structure; Ficl 4.0 adds "instructions", and changes over to
+mostly using a "switch-threaded" model. The result? Ficl 4.0
+is approximately <i>three times</i> as fast as Ficl 3.03.
+<p>
+
+Ficl 4.0 also adds the ability to store the "softcore" words
+as LZ77 compressed text. Decompression is so quick as to be
+nearly unmeasurable (0.00384 seconds on a 750MHz AMD Duron-based
+machine). And even with the runtime decompressor, the resulting
+Ficl executable is over 13k smaller!
+<p>
+
+Another new feature: Ficl 4.0 can take advantage of native
+support for double-word math. If your platform supports it,
+set the preprocessor symbol <code>FICL_HAVE_NATIVE_2INTEGER</code>
+to 1, and create <code>typedefs</code> for <code>ficl2Integer</code>
+and <code>ficl2Unsigned</code>.
+<p>
+
+Ficl 4.0 also features a retooled API, and a redesigned directory
+tree. The API is now far more consistent. But for those of you
+who are upgrading from Ficl 3.03 or before, you can enable API
+backwards compatibility by turning on the compile-time flag
+<code>FICL_WANT_COMPATIBILITY</code>.
+<p>
+
+Ficl 4.0 also extends support every kind of local and
+global value imaginable. Every values can individually
+be local or global, single-cell or double-cell, and
+integer or floating-point.
+And <code>TO</code> <i>always</i> does the right thing.
+<p>
+
+If you're using Ficl under Windows, you'll be happy
+to know that there's a brand-new build process.
+The Ficl build process now builds Ficl as
+<ul>
+
+<li>
+a static library (.LIB),
+
+<li>
+a dynamic library (.DLL, with a .LIB import library), and
+
+<li>
+a standalone executable (.EXE).
+
+</ul>
+
+Furthermore, each of these targets can be built in
+Debug or Release, Singlethreaded or Multithreaded,
+and optionally using the DLL version of the C runtime
+library for Multithreaded builds. (And, plus, the
+<code>/objects/common</code> nonsense is gone!)
+<p>
+
+
+Finally, Ficl 4.0 adds a <code>contrib</code>
+directory, a repository for user-contributed code that isn't
+part of the standard Ficl release. The only package there
+right now is <b>XClasses</b>, a Python-based IDL that generates
+the definition files for C++-based classes, the equivalent Ficl
+classes, and code to allow the Ficl classes to call the C++ methods.
+Using <b>XClasses</b> you can write your class once, and use it
+immediately from both C++ and Ficl.
+
+
+<? ficlHeader1("Getting Ficl") ?>+
+You can download Ficl from the
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441>
+Ficl download page at Sourceforge</a>.
+
+
+<? ficlPageFooter() ?>
--- /dev/null
+++ b/doc/source/license.ht
@@ -1,0 +1,47 @@
+<?
+ficlPageHeader("ficl licensing")+
+ficlAddToNavBarAs("Licensing")+
+ficlHeader1("Ficl License And Disclaimer")+
+?>
+
+<font size=+1>
+Copyright (c) 1997-2001 John Sadler ([email protected])
+<br>
+All rights reserved.
+</font>
+<p>
+
+<b>
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+<ol>
+
+<li>
+Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+<li>
+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.
+
+</ol>
+
+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.
+</b>
+
+<? ficlPageFooter() ?>
--- /dev/null
+++ b/doc/source/links.ht
@@ -1,0 +1,156 @@
+<?
+ficlPageHeader("ficl links")+
+ficlAddToNavBarAs("Links")+
+def linkto(href):
+ print "<p><dt>\n<a href=\"" + href + "\">" + href + "</a>\n<dd>\n"
+
+?>
+
+<? ficlHeader1("Official Ficl Pages") ?>+
+<dl>
+
+<? linkto("http://ficl.sourceforge.net") ?>+The official web home of Ficl.
+
+<? linkto("http://sourceforge.net/project/showfiles.php?group_id=24441") ?>+The Ficl download page.
+
+
+</dl>
+
+
+
+<? ficlHeader1("Forth Primers And Tutorials") ?>+
+<dl>
+
+<? linkto("http://www.phys.virginia.edu/classes/551.jvn.fall01/primer.htm") ?>+An excellent Forth primer, by Julian Nobel.
+
+<? linkto("http://ficl.sourceforge.net/pdf/Forth_Primer.pdf") ?>+Another excellent Forth primer, by Hans Bezemer.
+
+<? linkto("http://www.taygeta.com/forth_intro/stackflo.html") ?>+<i>An Introduction To Forth Using Stack Flow</i> by Gordon Charton.
+Mr. Charton's stack-flow diagrams make it easy to understand how
+to manipulate the FORTH stacks.
+
+<? linkto("http://www.softsynth.com/pforth/pf_tut.htm") ?>+Phil Burk's Forth Tutorial.
+
+</dl>
+
+
+
+<? ficlHeader1("Technical Articles On Ficl And Forth") ?>+
+<dl>
+
+<? linkto("articles/ficlddj.pdf") ?>+Manuscript of John Sadler's article on Ficl for January 1999 <a href=http://www.ddj.com>Dr. Dobb's Journal</a>.
+
+<? linkto("articles/jwsforml.pdf") ?>+1998 FORML Conference paper: <i>OO Programming in Ficl,</i> written and presented by John Sadler.
+
+
+<? linkto("http://www.complang.tuwien.ac.at/forth/threaded-code.html") ?>+Anton Ertl's description of threaded code techniques. (The FORTH-related definition
+of "threaded code" is different from—and predates—the common modern
+usage dealing with light-weight processes.) Ficl 4 uses what Ertl calls
+"switch threading".
+
+<? linkto("http://ficl.sourceforge.net/dpans/dpans.htm") ?>+1994 Draft Proposed American National Standard for Forth.
+And surprisingly readable, as language standards go.
+
+<? linkto("http://www.taygeta.com/forthlit.html") ?>+Forth literature index on Taygeta, a web clearinghouse of Forth links.
+
+</dl>
+
+<? ficlHeader1("Other Forth Sites Of Interest") ?>+
+<dl>
+
+<? linkto("http://www.forth.org") ?>+The Forth Interest Group.
+
+<? linkto("http://www.forth.com") ?>+FORTH, Incorporated. Thirty years old and going strong.
+You might be surprised to learn that they wrote software for
+the <a href=http://www.forth.com/Content/Stories/FedEx.htm>FedEx</a>
+"SuperTracker" bar code scanners / package trackers.
+
+</dl>
+
+<table width=100% bgcolor=#e0e0e0><tr><td width=160>
+<A href="http://t.webring.com/hub?sid=&ring=forth&list"><IMG src="graphics/4ring.gif" width="155" height="140" border="0" alt="Forth Webring Logo"></A>
+</td><td>
+<? ficlHeader1("The Forth Web Ring") ?>+<A href="http://t.webring.com/hub?sid=&ring=forth&id=47&prev5">Previous 5 Sites</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&id=47&prev">Previous</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&id=47&next">Next</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&id=47&next5">Next 5 Sites</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&random">Random Site</A><BR>
+<A href="http://t.webring.com/hub?sid=&ring=forth&list">List Sites</A></FONT>
+</td></tr></table>
+
+
+
+<? ficlHeader1("Some Software That Uses Ficl") ?>+
+<ul>
+<li>
+The <a href="http://www.freebsd.org/">FreeBSD</a> boot loader
+(Daniel Sobral, Jordan Hubbard)
+
+<li>
+<a href="http://www.chipcenter.com/networking/images/prod/prod158a.pdf">
+SwitchCore
+</a>
+Gigabit Ethernet switches (Örjan Gustavsson )
+
+<li>
+<a href="http://debuffer.sourceforge.net/">
+Palm Pilot Debuffer
+</a>
+(Eric Sessoms)
+Also see <a href=http://sonic-weasel.org/eric/ficlx/>FiclX</a>, a C++ interface to Ficl.
+
+<li>
+<a href="http://www.swcp.com/%7Ejchavez/osmond.html">
+Osmond PC Board Layout tool
+</a>
+
+<li>
+<a href="http://www.netcomsystems.com">
+NetCom Systems
+</a>
+ML7710
+
+<li>
+<a href="http://www.parview.com/ds/homepage.html">
+ParView
+</a>
+GPS system
+
+<li>
+<a href="http://www.thekompany.com/products/powerplant/software/Languages/Embedded.php3">
+PowerPlant Software
+</a>
+Development Environment for Linux
+
+<li>
+<a href="http://www.vyyo.com/products/architecture_v3000.html">
+Vyyo V3000 Broadband Wireless Hub
+</a>
+
+</ul>
+
+(Contact us if you'd like your name and product listed here.)
+
+
+<? ficlPageFooter() ?>
--- /dev/null
+++ b/doc/source/locals.ht
@@ -1,0 +1,133 @@
+<?
+
+ficlPageHeader("local variables in Ficl")+
+ficlAddToNavBarAs("Locals")+
+def entry(definition, description):
+ print "<tr><td bgcolor=#e0e0e0>\n<b>" + definition + "</b>\n</td><td bgcolor=#f0f0f0>\n" + description + "\n</td></tr>\n"
+
+?>
+
+
+<? ficlHeader1("An Overview And A History") ?>+
+
+
+Named, locally scoped variables came late to Forth. Purists feel that experienced
+Forth programmers can (and should) write supportable code using only anonymous
+stack variables and good factoring, and they complain that novices use
+global variables too frequently. But local variables cost little in terms of
+code size and execution speed, and are very convenient for OO programming
+(where stack effects are more complex).
+<p>
+
+Ficl provides excellent support
+for local variables, and the purists be damned—we use 'em all the time.
+<p>
+
+Local variables can only be declared inside a definition,
+and are only visible in that definition. Please refer to
+<a href="http://ficl.sourceforge.net/dpans/dpans13.htm">
+the ANS standard for FORTH
+</a> for more general information on local variables.
+
+
+<? ficlHeader1("John-Hopkins Forth Argument Syntax") ?>+
+ANS Forth does not specify a complete local variable facility.
+Instead, it defines a foundation upon which to build one. Ficl comes with
+an adaptation of the Johns-Hopkins local variable syntax, as developed by John
+Hayes et al. However, Ficl extends this syntax with support for double-cell and
+floating-point numbers.
+
+<p>
+
+Here's the basic syntax of a JH-local variable declaration:
+<blockquote><code>
+<b>{</b> <i>arguments</i>+<b>|</b> <i>locals</i>
+<b>--</b> <i>ignored</i>
+<b>}</b>
+</code></blockquote>
+(For experienced FORTH programmers: the declaration is designed to look like a stack comment,
+but it uses curly braces instead of parentheses.) Each section must list zero or more
+legal Ficl word names; comments and preprocessing are not allowed here.
+Here's what each section denotes:
+
+<ul>
+
+<li>
+The <i>arguments</i> section lists local variables which are initialized from the stack when the word executes.
+Each argument is set to the top value of the stack, starting at the rightmost argument name and moving left.
+You can have zero or more arguments.
+<p>
+
+<li>
+The <i>locals</i> section lists local variables which are set to zero when the word executes.
+You can have zero or more locals.
+<p>
+
+<li>
+Any characters between <code>--</code> and <code>}</code> are treated as a comment, and ignored.
+
+</ul>
+
+(The <code>|</code> and <code>--</code> sections are optional,
+but they must appear in the order shown if they appear at all.)
+<p>
+
+
+<? ficlHeader2("Argument Types") ?>+
+Every time you specify a local variable (in either the <i>arguments</i> or the <i>locals</i> section),
+you can also specify the <i>type</i> of the local variable. By default, a local variable
+is a single-cell integer; you can specify that the local be a double-cell integer, and/or a
+floating-point number.
+<p>
+
+To specify the type of a local, specify one or more of the following single-character specifiers,
+followed by a colon (<code>:</code>).
+
+<table>
+
+<? entry("1", "single-cell") ?>+
+<? entry("2", "double-cell") ?>+
+<? entry("d", "double-cell") ?>+
+<? entry("f", "floating-point (use floating stack)") ?>+
+<? entry("i", "integer (use data stack)") ?>+
+<? entry("s", "single-cell") ?>+
+</table>
+
+For instance, the argument <code>f2:foo</code> would specify a double-width floating-point
+number.
+<p>
+
+The type specifiers are read right-to left, and when two specifiers conflict, the rightmost
+one takes priority. So <code>2is1f2:foo</code> would still specifiy a double-width floating-point
+number.
+<p>
+
+Note that this syntax <i>only works</i> for Ficl's JH-locals. Locals
+defined in some other way (say, with the FORTH standard word <code>LOCALS|</code>)
+will ignore this syntax, and the entire string will be used as the name of
+the local (type and all).
+
+<? ficlHeader2("A Simple Example") ?>+
+<pre>
+: DEMONSTRATE-JH-LOCALS { c b a f:float -- a+b f:float*2 }+ a b +
+ 2.0e float f*
+ ;
+</pre>
+
+<?
+ficlPageFooter()
+?>
\ No newline at end of file
--- /dev/null
+++ b/doc/source/oop.ht
@@ -1,0 +1,1224 @@
+<?
+
+ficlPageHeader("ficl oop")+
+ficlAddToNavBarAs("OOP In Ficl")+
+def glossaryEntry(name, description):
+ print "<dt><code>" + name + " <i>" + description + "</i></code><dd>\n"
+
+?>
+
+<? ficlHeader1("Ficl Object Oriented Programming") ?>+
+
+Ficl's object extensions provide the traditional OO benefits of associating
+data with the code that manipulates it, and reuse through single inheritance.
+Ficl also has some unusual capabilities that support interoperation with
+systems written in C.
+<p>
+
+Some design points of Ficl's OOP system:
+
+<ul>
+
+<li>
+Ficl objects are normally late bound for safety (late binding guarantees
+that the appropriate method will always be invoked for a particular object).
+Early binding is also available, provided you know the object's class at
+compile-time.
+
+<li>
+Ficl OOP supports single inheritance, aggregation, and arrays of objects.
+
+<li>
+Classes have independent name spaces for their methods: methods are only
+visible in the context of a class or object. Methods can be overridden
+or added in subclasses; there is no fixed limit on the number of methods
+of a class or subclass.
+
+<li>
+Ficl OOP syntax is regular and unified over classes and objects. In ficl,
+all classes are objects. Class methods include the ability to subclass
+and instantiate.
+
+<li>
+Ficl can adapt legacy data structures with object wrappers. You can model
+a structure in a Ficl class, and create an instance that refers to an address
+in memory that holds an instance of the structure. The <i>ref object</i>
+can then manipulate the structure directly. This lets you wrap data structures
+written and instantiated in C.
+
+</ul>
+
+<? ficlHeader2("Object-Oriented Programming concepts") ?>+
+If you're not familiar with object-oriented programming, you
+can click <a href="http://whatis.techtarget.com/definition/0,289893,sid9_gci212681,00.html">here</a>
+or <a href="http://www.softwaredesign.com/objects.html">here</a> for
+a general-purpose overview.
+Or click <a href="articles/oo_in_c.html#review">here</a> for a short review of object-oriented ideas,
+terms, and implementations in C.
+
+<? ficlHeader2("Acknowledgements") ?>+
+Ficl is not the first Forth to include Object Oriented extensions. Ficl's
+OO syntax owes a debt to the work of John Hayes and Dick Pountain, among
+others. OO Ficl is different from other OO Forths in a few ways, though
+(some things never change). First, unlike several implementations, the
+syntax is documented (<a href="#ootutorial">below</a>) beyond the source
+code. In Ficl's spirit of working with C code, the OO syntax provides means
+to adapt existing data structures. I've tried to make Ficl's OO model simple
+and safe by unifying classes and objects, providing late binding by default,
+and separating namespaces so that methods and regular Forth words are not
+easily confused.
+
+
+<? ficlHeader2("Ficl Object Model") ?>+
+All classes in Ficl are derived from the common base class
+<code><a href="#objectgloss">OBJECT</a></code>
+as shown in the <a href="#figure1">figure</a> below. All classes are instances
+of <code><a href="#glossclass">METACLASS</a></code>. This means that classes
+are objects, too. <code>METACLASS</code> implements the methods for messages
+sent to classes. Class methods create instances and subclasses, and give
+information about the class. Each class is represented by a data stucture
+of three elements:
+
+<ol>
+
+<li>
+The address (named <code>.CLASS</code> ) of a parent class, or zero if it's
+a base class (only <code>OBJECT</code> and <code>METACLASS</code> have this property).
+
+<li>
+The size (named <code>.SIZE</code> ) in address units of an instance of the
+class.
+
+<li>
+A wordlist ID (named <code>.WID</code> ) for the methods of the class.
+
+</ol>
+
+In the figure below, <code>METACLASS</code> and <code>OBJECT</code> are real system-supplied
+classes. The others are contrived to illustrate the relationships among
+derived classes, instances, and the two system base classes. The dashed
+line with an arrow at the end indicates that the object/class at the arrow
+end is an instance of the class at the other end. The vertical line with
+a triangle denotes inheritance.
+<p>
+
+Note for the curious: <code>METACLASS</code> behaves like a class—it responds
+to class messages and has the same properties as any other class. If you
+want to twist your brain in knots, you can think of <code>METACLASS</code>
+as an instance of itself.
+<p>
+
+
+<a NAME="figure1"></a><img SRC="graphics/ficl_oop.jpg" VSPACE=10 height=442 width=652>
+<br>
+
+<? ficlHeader2("Ficl Object-Oriented Syntax Tutorial") ?>+<a NAME="ootutorial"></a>
+
+It's helpful to have some familiarity with Forth and the customary Forth
+stack notation to understand this tutorial. To get started, take a look
+at this <a href="http://www.taygeta.com/forth_intro/stackflo.html">web-based
+Forth tutorial</a>. If you're comfortable with both OO and Forth, you can
+<a href="#ootutorial-finally">jump ahead</a>.
+<p>
+
+A Ficl <a href="oo_in_c.html#object-def">object</a> associates a <a href="oo_in_c.html#class-def">class</a>
+with an <a href="oo_in_c.html#instance-def">instance</a> (the storage for
+one set of instance variables). This is done explicitly on Ficl's stack,
+in that any Ficl object is represented by a cell pair:
+<blockquote><code>( INSTANCE-address CLASS-address )</code></blockquote>
+
+The <code>INSTANCE-address</code> is the address of the object's storage, and the <code>CLASS-address</code>
+is the address of its class. Whenever a named Ficl object executes (e.g.
+when you type its name and press enter at the Ficl prompt), it leaves this
+"signature". All methods by convention expect a class and instance on the
+stack when they execute, too. In many other OO languages, including C++,
+instances contain information about their classes (a <a href="http://www.mvps.org/vbvision/vtable.htm">vtable</a>
+pointer, for example). By making this pairing explicit rather than implicit,
+Ficl can be OO about chunks of data that don't realize that they are objects,
+without sacrificing any robustness for native objects. That means that
+you can use Ficl to write object wrappers for data structures created in
+C or assembly language, as long as you can determine how they're laid out
+in memory.
+<p>
+
+Whenever you create an object in Ficl, you specify its class.
+After that, the object always pushes its class and the address of its
+<a href="http://www.aware.com/Glossary/main.htm#P">payload</a>
+(instance variable space) when invoked by name.
+<p>
+
+Classes are special kinds of objects that store the methods of their
+instances, the size of an instance's payload, and a parent class pointer.
+Classes themselves are instances of a special base class called <code>METACLASS</code>,
+and all classes inherit from class <code>OBJECT</code>. This is confusing at
+first, but it means that Ficl has a very simple syntax for constructing
+and using objects. Class methods include subclassing (<code>SUB</code>), creating
+initialized and uninitialized instances (<code>NEW</code> and <code>INSTANCE</code>),
+and creating reference instances (<code>REF</code>), described later. Classes
+also have methods for disassembling their methods (<code>SEE</code>), identifying
+themselves (<code>ID</code>), and listing their pedigree (<code>PEDIGREE</code>).
+All objects inherit (from <code>OBJECT</code>) methods for initializing instances
+and arrays of instances, for performing array operations, and for getting
+information about themselves.
+
+<? ficlHeader3("Methods And Messages") ?>+
+Methods are the functions that objects execute in response to messages.
+A message is a request to an object for a behavior that the object supports.
+When it receives a message, the target object looks up a method that performs
+the behavior for its class, and executes it. Any specific message may be
+bound to different methods in different objects, according to class. This
+separation of messages and methods allows objects to behave <a href="http://www.whatis.com/polymorp.htm">polymorphically</a>.
+(In Ficl, methods are words defined in the context of a class, and messages
+are the names of those words.) Ficl classes associate messages with methods
+for their instances (a fancy way of saying that each class owns a wordlist).
+Ficl provides a late-binding operator <code>--></code> that sends messages
+to objects at run-time, and an early-binding operator <code>=></code>
+that compiles a specific class's method. These operators are the only supported
+way to invoke methods. Regular Forth words are not visible to the method-binding
+operators, so there's no chance of confusing a message with a regular
+word of the same name.
+
+<a NAME="ootutorial-finally"></a>
+
+<? ficlHeader2("Tutorial") ?>+
+(Finally!)
+<p>
+
+This is a tutorial. It works best if you follow along by pasting the examples
+into <b>ficlWin</b>, the Win32 version of Ficl included with the release sources
+(or some other build that includes the OO part of <code>softcore.c</code>). If you're
+not familiar with Forth, please see one of these <a href="#links">references</a>.
+Ficl's OOP words are in vocabulary <code>OOP</code>. To put <code>OOP</code> in
+the search order and make it the compilation wordlist, type:
+<pre>
+ONLY
+ALSO OOP DEFINITIONS
+</pre>
+
+<b>Note for beginners:</b> To see the effect of the commands above, type
+<code>ORDER</code>
+after each line. You can repeat the sequence above if you like.
+<p>
+
+To start, we'll work with the two base classes <code>OBJECT</code> and <code>METACLASS</code>.
+Try this:
+<pre>
+METACLASS --> METHODS
+</pre>
+
+The line above contains three words. The first is the name of a class,
+so it pushes its signature on the stack. Since all classes are instances
+of <code>METACLASS</code>, <code>METACLASS</code> behaves as if it is an instance
+of itself (this is the only class with this property). It pushes the same
+address twice: once for the class and once for the payload, since they
+are the same. The next word finds a method in the context of a class and
+executes it. In this case, the name of the method is <code>METHODS</code>.
+Its job is to list all the methods that a class knows. What you get when
+you execute this line is a list of all the class methods Ficl provides.
+<pre>
+OBJECT --> SUB C-LED
+</pre>
+Causes the base-class <code>OBJECT</code> to derive from itself a new class
+called <code>C-LED</code>. Now we'll add some instance variables and methods to the new class.
+<p>
+
+<b>Note:</b> I like to prefix the names of classes with <code>c-</code> and the
+names of member variables with a period, but this is just a convention.
+If you don't like it, pick your own.
+<pre>
+C-BYTE OBJ: .STATE
+: INIT { 2:THIS -- }+ THIS --> SUPER --> INIT
+ ." Initializing an instance of "
+ THIS --> CLASS --> ID TYPE CR ;
+: 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&NBSP; ;
+END-CLASS
+</pre>
+The first line adds an instance variable called <code>.STATE</code> to the
+class. This particular instance variable is an object—it will be an instance
+of <code>C-BYTE</code>, one of Ficl's stock classes (the source for which can be found
+in the distribution in <code>softcore/classes.fr</code>).
+<p>
+
+Next we've defined a method called <code>INIT</code>. This line also declares
+a <a href="locals.html">local variable</a> called <code>THIS</code>
+(the 2 in front tells Ficl that this is a double-cell local). All methods
+by convention expect the address of the class and instance on top of the
+stack when called. The next three lines define the behavior of <code>INIT</code> when it's called.
+It first calls its superclass's version of <code>INIT</code> (which in this
+case is "<code>OBJECT => INIT</code>"—this default implementation clears all
+instance variables). The rest displays some text and causes the instance
+to print its class name (<code>THIS --> CLASS --> ID</code>).
+<p>
+
+The <code>INIT</code>> method is special for Ficl objects: whenever
+you create an initialized instance using <code>NEW</code> or <code>NEW-ARRAY</code>,
+Ficl calls the class's <code>INIT</code> method for you on that instance. The
+default <code>INIT</code> method supplied by <code>OBJECT</code> clears the instance,
+so we didn't really need to override it in this case (see the source code
+in <code>softcore/oo.fr</code>).
+<p>
+
+The <code>ON</code> and <code>OFF</code> methods defined above hide the details
+of turning LEDs on and off. The interface to FiclWin's simulated hardware
+is handled by <code>!OREG</code>. The class keeps the LED state in a shadow
+variable (<code>.STATE</code>) so that <code>ON</code> and <code>OFF</code> can work
+in terms of LED number rather than a bitmask.
+<p>
+
+Now make an instance of the new class:
+<pre>
+C-LED --> NEW LED
+</pre>
+
+And try a few things...
+<pre>
+LED --> METHODS
+LED --> PEDIGREE
+1 LED --> ON
+1 LED --> OFF
+</pre>
+
+Or you could type this with the same effect:
+<pre>
+LED 2DUP --> METHODS --> PEDIGREE
+</pre>
+
+Notice (from the output of <code>METHODS</code>) that we've overridden the
+<code>INIT</code> method supplied by object, and added two more methods for the member
+variables. If you type <code>WORDS</code>, you'll see that these methods are
+not visible outside the context of the class that contains them. The method
+finder <code>--></code> uses the class to look up methods. You can use
+this word in a definition, as we did in <code>INIT</code>, and it performs
+late binding, meaning that the mapping from message (method name) to method
+(the code) is deferred until run-time. To see this, you can decompile the
+init method like this:
+<pre>
+C-LED --> SEE INIT
+</pre>
+
+or
+<pre>
+LED --> CLASS --> SEE INIT
+</pre>
+
+<? ficlHeader2("Early Binding") ?>+
+Ficl also provides early binding if you ask for it. Early binding is not
+as safe as late binding, but it produces code that is more compact and
+efficient because it compiles method addresses rather then their names.
+In the preferred uses of early binding, the class is assumed to be the
+one you're defining. This kind of early binding can only be used inside
+a class definition. Early bound methods still expect to find a class and
+instance cell-pair on top of the stack when they run.
+<p>
+
+Here's an example that illustrates a potential problem:
+<pre>
+OBJECT --> SUB C1
+: M1 { 2:THIS -- } ." C1'S M1" CR ;+: M2 { 2:THIS -- } ." Running " THIS MY=> M1 ; ( early )+: M3 { 2:THIS -- } ." Running " THIS --> M1 ( late )+END-CLASS
+C1 --> SUB C2
+: M1 { 2:THIS -- } ." C2'S M1" CR ;+END-CLASS
+C2 --> NEW I2
+I2 --> M1 ( runs the M1 defined in C2 )
+I2 --> M2 ( Is this what you wanted? )
+I2 --> M3 { runs the overridden M1)+</pre>
+
+Even though we overrode method <code>M1</code> in class <code>C2</code>, the definition of <code>M2</code> with
+early binding forced the use of <code>M1</code> as defined in <code>C1</code>. If that's what you
+want, great, but more often you'll want the flexibility of overriding parent
+class behaviors appropriately.
+
+<ol>
+
+<li>
+<code>MY=></code> binds early to a method in the class being defined,
+as in the example above.
+
+<li>
+<code>MY=[ ]</code> binds a sequence of methods in the current class.
+Useful when the class has object members. Lines like
+<code>THIS --> STATE --> SET</code> in the definition of <code>C-LED</code> above can be replaced with
+<code>THIS MY=[ STATE SET ]</code> to use early binding.
+
+<li>
+<code>=></code> (dangerous) pops a class off the stack and compiles
+the method in that class. Since you have to specify the class explicitly,
+there is a real danger that this will be out of sync with the class you
+really wanted. I recommend you use <code>MY=></code> or <code>MY=[ ]</code> instead.
+
+</ol>
+
+Early binding using <code>=></code> is dangerous because it partially
+defeats the data-to-code matching mechanism object oriented languages were
+created to provide, but it does increase run-time speed by binding the
+method at compile time. In many cases, such as the <code>INIT</code> method,
+you can be reasonably certain of the class of thing you're working on.
+This is also true when invoking class methods, since all classes are instances
+of <code>METACLASS</code>. Here's an example from the definition of <code>METACLASS</code>
+in oo.fr (don't paste this into ficlWin—it's already there):
+<pre>
+: NEW \ ( class metaclass "name" -- )
+ METACLASS => INSTANCE --> INIT ;
+</pre>
+
+Try this:
+<pre>
+METACLASS --> SEE NEW
+</pre>
+
+Decompiling the method with <code>SEE</code> shows the difference between the
+two strategies. The early bound method is compiled inline, while the late-binding
+operator compiles the method name and code to find and execute it in the
+context of whatever class is supplied on the stack at run-time.
+<p>
+
+Notice that the primitive early-binding operator <code>=></code> requires
+a class at compile time. For this reason, classes are <code>IMMEDIATE</code>,
+meaning that they push their signature at compile time or run time. I'd
+recommend that you avoid early binding until you're very comfortable with
+Forth, object-oriented programming, and Ficl's OOP syntax.
+
+<? ficlHeader2("More About Instance Variables") ?>+
+<i>Untyped</i> instance variable methods (created by <code>CELL: CELLS: CHAR:</code>
+and <code>CHARS:</code>) just push the address of the corresponding instance
+variable when invoked on an instance of the class. It's up to you to remember
+the size of the instance variable and manipulate it with the usual Forth
+words for fetching and storing.
+<p>
+
+As advertised earlier, Ficl provides ways to objectify existing data
+structures without changing them. Instead, you can create a Ficl class
+that models the structure, and instantiate a <i>ref</i> from this class,
+supplying the address of the structure. After that, the <i>ref instance</i>
+behaves as a Ficl object, but its instance variables take on the values
+in the existing structure. Example (from <code>softcore/ficlclass.fr</code>):
+<pre>
+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
+</pre>
+
+In this case, <code>C-WORDLIST</code> describes Ficl's wordlist structure;
+<code>NAMED-WID</code> creates a wordlist and binds it to a ref instance of
+<code>C-WORDLIST</code>.
+The fancy footwork with <code>POSTPONE</code> and early binding is required
+because classes are immediate. An equivalent way to define <code>NAMED-WID</code> with
+late binding is:
+<pre>
+: NAMED-WID ( c-address u -- )
+ WORDLIST POSTPONE C-WORDLIST --> REF
+ ;
+</pre>
+
+To do the same thing at run-time (and call it <code>MY-WORDLIST</code>):
+
+<pre>wordlist c-wordlist --> ref my-wordlist</pre>
+
+Now you can deal with the wordlist through the ref instance:
+<pre>
+MY-WORDLIST --> PUSH
+MY-WORDLIST --> SET-CURRENT
+ORDER
+</pre>
+
+Ficl can also model linked lists and other structures that contain pointers
+to structures of the same or different types. The class constructor word
+<a href="#exampleref:"><code>REF:</code></a>
+makes an aggregate reference to a particular class. See the <a href="#glossinstance">instance
+variable glossary</a> for an <a href="#exampleref:">example</a>.
+<p>
+
+Ficl can make arrays of instances, and aggregate arrays into class descripions.
+The <a href="#glossclass">class methods</a> <code>ARRAY</code> and <code>NEW-ARRAY</code>
+create uninitialized and initialized arrays, respectively, of a class.
+In order to initialize an array, the class must define (or inherit) a reasonable
+<code>INIT</code> method. <code>NEW-ARRAY</code> invokes it on each member of the array
+in sequence from lowest to highest. Array instances and array members use
+the object methods <code>INDEX</CODE>, <CODE>NEXT</CODE>, and <CODE>PREV</code>
+to navigate. Aggregate a member array of objects using <a href="#arraycolon"><code>ARRAY:</code></a>.
+The objects are not automatically initialized in this case—your class
+initializer has to call <code>ARRAY-INIT</code> explicitly if you want
+this behavior.
+<p>
+
+For further examples of OOP in Ficl, please see the source file <code>softcore/ficlclass.fr</code>.
+This file wraps several Ficl internal data structures in objects and gives
+use examples.
+
+
+<? ficlHeader1("Ficl String Classes") ?>+<a NAME="cstring"></a>
+
+<code>C-STRING</code> is a reasonably useful dynamic string class.
+Source code for the class is located in <code>softcore/string.fr</code>.
+Features:
+dynamic creation and resizing; deletion, char cout, concatenation, output,
+comparison; creation from quoted string constant (<code>S"</code>).
+<p>
+Examples of use:
+<pre>
+C-STRING --> NEW HOMER
+S" In this house, " HOMER --> SET
+S" we obey the laws of thermodynamics!" HOMER --> CAT
+HOMER --> TYPE
+</pre>
+
+
+<? ficlHeader2("OOP Glossary") ?>+
+<a NAME="oopgloss"></a>
+
+<b>Note:</b> With the exception of the binding operators (the first two definitions
+here), all of the words in this section are internal factors that you don't
+need to worry about. These words provide method binding for all classes
+and instances. Also described are supporting words and execution factors.
+All are defined in <code>softcore/oo.fr</code>.
+
+<dl>
+
+<? glossaryEntry("-->", "( instance class \"method-name\" -- xn )") ?>+
+Late binding: looks up and executes the given method in the context of
+the class on top of the stack.
+
+<? glossaryEntry("C->", "( instance class \"method-name\" -- xn exc )") ?>+
+Late binding with <code>CATCH</code>: looks up and <code>CATCH</code>es the given
+method in the context of the class on top of the stack, pushes zero or
+exception code upon return.
+
+<? glossaryEntry("MY=>", "compilation: ( \"method-name\" -- ) execution: ( instance class -- xn )") ?>+
+Early binding: compiles code to execute the method of the class being defined.
+Only visible and valid in the scope of a <code>--> SUB</CODE> .. <CODE>END-CLASS</code>
+class definition.
+
+<? glossaryEntry("MY=[", "compilation: ( \"obj1 obj2 .. method ]\" -- ) execution: ( instance class -- xn )") ?>+
+Early binding: compiles code to execute a chain of methods of the class
+being defined. Only visible and valid in the scope of a <code>--> SUB</CODE>
+.. <CODE>END-CLASS</code> class definition.
+
+<? glossaryEntry("=>", "compilation: ( class metaclass \"method-name\" -- ) execution: ( instance class -- xn )") ?>+
+Early binding: compiles code to execute the method of the class specified
+at compile time.
+
+<? glossaryEntry("do-do-instance", "") ?>+
+When executed, causes the instance to push its <code>( INSTANCE CLASS )</code> stack
+signature. Implementation factor of <code>METACLASS --> SUB</code></b> .
+Compiles <code>.DO-INSTANCE</code> in the context of a class; <code>.DO-INSTANCE</code>
+implements the <code>DOES></code> part of a named instance.
+
+<? glossaryEntry("exec-method", "( instance class c-address u -- xn )") ?>+
+Given the address and length of a method name on the stack, finds
+the method in the context of the specified class and invokes it. Upon entry
+to the method, the instance and class are on top of the stack, as usual.
+If unable to find the method, prints an error message and aborts.
+
+<? glossaryEntry("find-method-xt", "( class \"method-name\" -- class xt )") ?>+
+Attempts to map the message to a method in the specified class. If successful,
+leaves the class and the execution token of the method on the stack. Otherwise
+prints an error message and aborts.
+
+<? glossaryEntry("lookup-method", "( class c-address u -- class xt )") ?>+
+Given the address and length of a method name on the stack, finds
+the method in the context of the specified class. If unable to find the
+method, prints an error message and aborts.
+
+<? glossaryEntry("parse-method", "compilation: ( \"method-name\" -- ) execution: ( -- c-address u )") ?>+
+Parse <code>"method-name"</code> from the input stream and compile code to push its length
+and address when the enclosing definition runs.
+</dl>
+
+<? ficlHeader3("Instance Variable Glossary") ?>+<a NAME="glossinstance"></a>
+
+<b>Note:</b>: These words are only visible when creating a subclass! To
+create a subclass, use the <code>SUB</code> method on <code>OBJECT</code> or any
+class derived from it (<i>not</i> <code>METACLASS</code>). Source code for
+Ficl OOP is in <code>softcore/oo.fr</code>.
+<p>
+
+Instance variable words do two things: they create methods that do
+san action appropriate for the type of instance variable they represent,
+and they reserve space in the class template for the instance variable.
+We'll use the term <i>instance variable</i> to refer both to the method
+that gives access to a particular field of an object, and to the field
+itself. Rather than give esentially the same example over and over, here's
+one example that shows several of the instance variable construction words
+in use:
+
+<pre>
+OBJECT SUBCLASS C-EXAMPLE
+ CELL: .CELL0
+ C-4BYTE OBJ: .NCELLS
+ 4 C-4BYTE ARRAY: .QUAD
+ CHAR: .LENGTH
+ 79 CHARS: .NAME
+END-CLASS
+</pre>
+
+This class only defines instance variables, and it inherits some methods
+from <code>OBJECT</code>. Each untyped instance variable (<code>.CELL0</code>, <code>.LENGTH</code>,
+<code>.NAME</code>) pushes its address when executed. Each object instance variable
+pushes the address and class of the aggregate object. Similar to C, an
+array instance variable leaves its base address (and its class) when executed.
+The word <code>SUBCLASS</code> is shorthand for <code>--> sub</code> .
+
+<dl>
+
+<? glossaryEntry("CELL:", "compilation: ( offset \"name\" -- offset ) execution: ( -- cell-address )") ?>+
+Create an untyped instance variable one cell wide. The instance variable
+leaves its payload's address when executed.
+
+<? glossaryEntry("CELLS:", "compilation: ( offset nCells \"name\" -- offset' ) execution: ( -- cell-address )") ?>+
+Create an untyped instance variable <code>nCells</code> cells wide.
+
+<? glossaryEntry("CHAR:", "compilation: ( offset \"name\" -- offset' ) execution: ( -- cell-address )") ?>+
+Create an untyped member variable one character wide.
+
+<? glossaryEntry("CHARS:", "compilation: ( offset nChars \"name\" -- offset' ) execution: ( -- cell-address )") ?>+
+Create an untyped member variable <code>nChars</code> characters wide.
+
+<? glossaryEntry("OBJ:", "compilation: ( offset class metaclass \"name\" -- offset' ) execution: ( -- instance class )") ?>+
+Aggregate an uninitialized instance of <code>CLASS</code> as a member variable
+of the class under construction.
+
+<? glossaryEntry("ARRAY:", "compilation: ( offset nObjects class metaclass \"name\" -- offset' ) execution: ( -- instance class )") ?>+<a NAME="arraycolon"></a>
+
+Aggregate an uninitialized array of instances of the class specified as
+a member variable of the class under construction.
+
+<? glossaryEntry("EXAMPLEREF:", "compilation: ( offset class metaclass \"name\" -- offset' ) execution: ( -- ref-instance ref-class )") ?>+
+Aggregate a reference to a class instance. There is no way to set the value
+of an aggregated ref—it's meant as a way to manipulate existing data
+structures with a Ficl OO model. For example, if your system contains a
+linked list of 4 byte quantities, you can make a class that represents
+a list element like this:
+
+<pre>
+OBJECT SUBCLASS C-4LIST
+ C-4LIST REF: .LINK
+ C-4BYTE OBJ: .PAYLOAD
+END-CLASS
+
+ADDRESS-OF-EXISTING-LIST C-4LIST --> REF MYLIST
+</pre>
+
+<dd>
+The last line binds the existing structure to an instance of the class
+we just created. The link method pushes the link value and the class <code>C_4LIST</code>,
+so that the link looks like an object to Ficl and like a struct to C (it
+doesn't carry any extra baggage for the object model—the Ficl methods
+alone take care of storing the class information).
+<p>
+
+<b>Note:</b> Since a <code>REF:</code> aggregate can only support one class, it's good for
+modeling static structures, but not appropriate for polymorphism. If you
+want polymorphism, aggregate a <code>C_REF</code> (see <code>softcore/classes.fr</code> for source)
+into your class—it has methods to set and get an object.
+<p>
+
+By the way, it is also possible to construct a pair of classes that contain
+aggregate pointers to each other. Here's an example:
+
+<pre>
+OBJECT SUBCLASS AKBAR
+ SUSPEND-CLASS \ put akbar on hold while we define jeff
+
+OBJECT SUBCLASS JEFF
+ AKBAR REF: .SIGNIFICANT-OTHER
+ ( <i>... your additional methods here ...</i> )
+END-CLASS \ done with jeff
+
+AKBAR --> RESUME-CLASS \ resume defining akbar
+ JEFF REF: .SIGNIFICANT-OTHER
+ ( <i>... your additional methods here ...</i> )
+END-CLASS \ done with akbar
+</pre>
+
+</dl>
+
+<a NAME="glossclass"></a>
+<? ficlHeader1("Class Methods Glossary") ?>+
+These words are methods of <code>METACLASS</code>. They define the manipulations
+that can be performed on classes. Methods include various kinds of instantiation,
+programming tools, and access to member variables of classes. Source is
+in <code>softcore/oo.fr</code>.
+
+<dl>
+
+<? glossaryEntry("INSTANCE", "( class metaclass \"name\" -- instance class )") ?>+
+Create an uninitialized instance of the class, giving it the name specified.
+The method leaves the instance's signature on the stack (handy if you
+want to initialize). Example:
+
+<pre>
+C_REF --> INSTANCE UNINIT-REF 2DROP
+</pre>
+
+<? glossaryEntry("NEW", "( class metaclass \"name\" -- )") ?>+
+Create an initialized instance of class, giving it the name specified.
+This method calls <code>INIT</code> to perform initialization.
+
+<? glossaryEntry("ARRAY", "( nObjects class metaclass \"name\" -- nObjects instance class )") ?>+
+Create an array of <code>nObjects</code> instances of the specified class.
+Instances are not initialized. Example:
+
+<pre>
+10 C_4BYTE --> ARRAY 40-RAW-BYTES 2DROP DROP
+</pre>
+
+
+<? glossaryEntry("NEW-ARRAY", "( nObjects class metaclass \"name\" -- )") ?>+
+Creates an initialized array of <code>nObjects</code> instances of the class.
+Same syntax as <code>ARRAY</code>.
+
+<a NAME="alloc"></a>
+<? glossaryEntry("ALLOC", "( class metaclass -- instance class )") ?>+
+Creates an anonymous instance of <code>CLASS</code> from the heap (using a call
+to <code>ficlMalloc()</code> to get the memory). Leaves the payload and class addresses
+on the stack. Usage example:
+
+<pre>
+C-REF --> ALLOC 2CONSTANT INSTANCE-OF-REF
+</pre>
+<p>
+
+Creates a double-cell constant that pushes the payload and class address
+of a heap instance of <code>C-REF</code>.
+
+<a NAME="allocarray"></a>
+<? glossaryEntry("ALLOC-ARRAY", "( nObjects class metaclass -- instance class )") ?>+
+Same as <code>NEW-ARRAY</code>, but creates anonymous instances from the heap using
+a call to <code>ficlMalloc()</code>. Each instance is initialized using the class's
+<code>INIT</code> method.
+
+<a NAME="allot"></a>
+<? glossaryEntry("ALLOT", "( class metaclass -- instance class )") ?>+
+Creates an anonymous instance of <code>CLASS</code> from the dictionary. Leaves
+the payload and class addresses on the stack. Usage example:
+
+<pre>
+C-REF --> ALLOT 2CONSTANT INSTANCE-OF-REF
+</pre>
+
+<p>
+
+Creates a double-cell constant that pushes the payload and class address
+of a heap instance of <code>C-REF</code>.
+
+<a NAME="allotarray"></a>
+<? glossaryEntry("ALLOT-ARRAY", "( nObjects class metaclass -- instance class )") ?>+
+Same as <code>NEW-ARRAY</code>, but creates anonymous instances from the dictionary.
+Each instance is initialized using the class's <code>INIT</code> method.
+
+<? glossaryEntry("REF", "( instance-address class metaclass \"name\" -- )") ?>+
+Make a ref instance of the class that points to the supplied instance address.
+No new instance space is allotted. Instead, the instance refers to the
+address supplied on the stack forever afterward. For wrapping existing
+structures.
+
+
+<? glossaryEntry("SUB", "( class metaclass -- old-wid address[size] size )") ?>+
+Derive a subclass. You can add or override methods, and add instance variables.
+Alias: <code>SUBCLASS</code>. Examples:
+<p>
+
+<pre>
+C_4BYTE --> SUB C_SPECIAL4BYTE
+ ( <i>... your new methods and instance variables here ...</i> )
+END-CLASS
+</pre>
+
+or
+
+<pre>
+C_4BYTE SUBCLASS C_SPECIAL4BYTE
+ ( <i>... your new methods and instance variables here ...</i> )
+END-CLASS
+</pre>
+
+<? glossaryEntry(".SIZE", "( class metaclass -- instance-size )") ?>+
+Returns address of the class's instance size field, in address units. This
+is a metaclass member variable.
+
+<? glossaryEntry(".SUPER", "( class metaclass -- superclass )") ?>+
+Returns address of the class's superclass field. This is a metaclass member
+variable.
+
+<? glossaryEntry(".WID", "( class metaclass -- wid )") ?>+
+Returns the address of the class's wordlist ID field. This is a metaclass
+member variable.
+
+<? glossaryEntry("GET-SIZE", "( -- instance-size )") ?>+
+Returns the size of an instance of the class in address units. Imeplemented
+as follows:
+
+<pre>
+: GET-SIZE METACLASS => .SIZE @ ;
+</pre>
+
+<? glossaryEntry("GET-WID", "( -- wid )") ?>+
+Returns the wordlist ID of the class. Implemented as:
+
+<pre>
+: GET-WID METACLASS => .WID @ ;
+</pre>
+
+<? glossaryEntry("GET-SUPER", "( -- superclass )") ?>+
+Returns the class's superclass. Implemented as
+
+<pre>
+: GET-SUPER METACLASS => .super @ ;
+</pre>
+
+
+<? glossaryEntry("ID", "( class metaclass -- c-address u )") ?>+
+Returns the address and length of a string that names the class.
+
+
+<? glossaryEntry("METHODS", "( class metaclass -- )") ?>+
+Lists methods of the class and all its superclasses.
+
+
+<? glossaryEntry("OFFSET-OF", "( class metaclass \"name\" -- offset )") ?>+
+Pushes the offset from the instance base address of the named member variable.
+If the name is not that of an instance variable method, you get garbage.
+There is presently no way to detect this error. Example:
+
+<pre>
+metaclass --> offset-of .wid
+</pre>
+
+
+<? glossaryEntry("PEDIGREE", "( class metaclass -- )") ?>+
+
+Lists the pedigree of the class (inheritance trail).
+
+<? glossaryEntry("SEE", "( class metaclass \"name\" -- )") ?>+
+Decompiles the specified method—obect version of <code>SEE</code>, from the
+<code>TOOLS</code> wordset.
+
+</dl>
+
+<? ficlHeader1("<code>OBJECT</code> Base-Class Methods Glossary") ?>+<a NAME="objectgloss"></a>
+
+These are methods that are defined for all instances by the base class
+<code>OBJECT</code>.
+The methods include default initialization, array manipulations, aliases
+of class methods, upcasting, and programming tools.
+
+<dl>
+
+<? glossaryEntry("INIT", "( instance class -- )") ?>+
+Default initializer, called automatically for all instances created with
+<code>NEW</code>
+or <code>NEW-ARRAY</code>. Zero-fills the instance. You do not normally need
+to invoke <code>INIT</code> explicitly.
+
+<? glossaryEntry("ARRAYINIT", "( nObjects instance class -- )") ?>+
+Applies <code>INIT</code> to an array of objects created by <code>NEW-ARRAY</code>.
+Note that <code>ARRAY:</code> does not cause aggregate arrays to be initialized
+automatically. You do not normally need to invoke <code>ARRAY-INIT</code> explicitly.
+
+<? glossaryEntry("FREE", "( instance class -- )") ?>+
+Releases memory used by an instance previously created with <code>ALLOC</code>
+or <code>ALLOC-ARRAY</code>. <b>Note:</b> This method is not presently protected
+against accidentally deleting something from the dictionary. If you do
+this, Bad Things are likely to happen. Be careful for the moment to apply
+free only to instances created with <code>ALLOC</code> or <code>ALLOC-ARRAY</code>.
+
+<? glossaryEntry("CLASS", "( instance class -- class metaclass )") ?>+
+Convert an object signature into that of its class. Useful for calling
+class methods that have no object aliases.
+
+<? glossaryEntry("SUPER", "( instance class -- instance superclass )") ?>+
+Upcast an object to its parent class. The parent class of <code>OBJECT</code>
+is zero. Useful for invoking an overridden parent class method.
+
+<? glossaryEntry("PEDIGREE", "( instance class -- )") ?>+
+Display an object's pedigree—its chain of inheritance. This is an alias
+for the corresponding class method.
+
+<? glossaryEntry("SIZE", "( instance class -- instance-size )") ?>+
+Returns the size, in address units, of one instance. Does not know about
+arrays! This is an alias for the class method <code>GET-SIZE</code>.
+
+<? glossaryEntry("METHODS", "( instance class -- )") ?>+
+Class method alias. Displays the list of methods of the class and all superclasses
+of the instance.
+
+<? glossaryEntry("INDEX", "( n instance class -- instance[n] class )") ?>+
+Convert array-of-objects base signature into signature for array element
+n. No check for bounds overflow. Index is zero-based, like C, so
+
+<pre>
+0 MY-OBJ --> INDEX
+</pre>
+
+is equivalent to
+
+<pre>
+MY-OBJ
+</pre>
+
+Check out the <a href="#minusrot">description of <code>-ROT</code></a> for
+help in dealing with indices on the stack.
+
+<? glossaryEntry("NEXT", "( instance[n] class -- instance[n+1] )") ?>+
+Convert an array-object signature into the signature of the next
+object in the array. No check for bounds overflow.
+
+<? glossaryEntry("PREV", "( instance[n] class -- instance[n-1] class )") ?>+
+Convert an object signature into the signature of the previous object
+in the array. No check for bounds underflow.
+
+</dl>
+
+
+<? ficlHeader2("Supplied Classes") ?>+<a NAME="stockclasses"></a>
+
+For more information on theses classes, see <code>softcore/classes.fr</code>.
+
+<dl>
+
+<? glossaryEntry("METACLASS", "") ?>+
+Describes all classes of Ficl. Contains class methods. Should never be
+directly instantiated or subclassed. Defined in <code>softcore/oo.fr</code>. Methods described
+above.
+
+<? glossaryEntry("OBJECT", "") ?>+
+Mother of all Ficl objects. Defines default initialization and array indexing
+methods. Defined in <code>softcore/oo.fr</code>. Methods described above.
+
+<? glossaryEntry("C-REF", "") ?>+
+Holds the signature of another object. Aggregate one of these into a data
+structure or container class to get polymorphic behavior. Methods and members:
+
+<dl>
+
+<? glossaryEntry("GET", "( instance class -- ref-instance ref-class )") ?>+Push the referenced object value on the stack.
+
+<? glossaryEntry("SET", "( ref-instance ref-class instance class -- )") ?>+Set the referenced object being held.
+
+<? glossaryEntry(".INSTANCE", "( instance class -- a-address )") ?>+Cell member that holds the instance.
+
+<? glossaryEntry(".CLASS", "( instance class -- a-address )") ?>+Cell member that holds the class.
+
+</dl>
+
+<? glossaryEntry("C-BYTE", "") ?>+
+Primitive class derived from <code>OBJECT</code>, with a 1-byte payload. <code>SET</code>
+and <code>GET</code> methods perform correct width fetch and store. Methods and members:
+
+<dl>
+
+<? glossaryEntry("GET", "( instance class -- byte )") ?>+Push the object's value on the stack.
+
+<? glossaryEntry("SET", "( byte instance class -- )") ?>+Set the object's value from the stack.
+
+<? glossaryEntry(".PAYLOAD", "( instance class -- address )") ?>+Member holds instance's value.
+
+</dl>
+
+<? glossaryEntry("C-2BYTE", "") ?>+
+Primitive class derived from <code>OBJECT</code>, with a 2-byte payload. <code>SET</code>
+and <code>GET</code> methods perform correct width fetch and store. Methods and members:
+
+<dl>
+
+<? glossaryEntry("GET", "( instance class -- 2byte )") ?>+Push the object's value on the stack.
+
+<? glossaryEntry("SET", "( 2byte instance class -- )") ?>+Set the object's value from the stack.
+
+<? glossaryEntry(".PAYLOAD", "( instance class -- address )") ?>+Member holds instance's value.
+
+</dl>
+
+<? glossaryEntry("C-4BYTE", "") ?>+Primitive class derived from <code>object</code>, with a 4-byte payload. <code>SET</code>
+and <code>GET</code> methods perform correct width fetch and store. Methods and members:
+
+<dl>
+
+<? glossaryEntry("GET", "( instance class -- 4byte )") ?>+Push the object's value on the stack.
+
+<? glossaryEntry("SET", "( 4byte instance class -- )") ?>+Set the object's value from the stack.
+
+<? glossaryEntry(".PAYLOAD", "( instance class -- address )") ?>+Member holds instance's value.
+
+</dl>
+
+<? glossaryEntry("C-CELL", "") ?>+
+Primitive class derived from <code>OBJECT</code>, with a cell payload (equivalent
+to <code>C-4BYTE</code> on 32 bit platforms, 64 bits wide on Alpha and other
+64-bit platforms). <code>SET</code>
+and <code>GET</code> methods perform correct width fetch and store. Methods and members:
+
+<dl>
+
+<? glossaryEntry("GET", "( instance class -- 4byte )") ?>+Push the object's value on the stack.
+
+<? glossaryEntry("SET", "( 4byte instance class -- )") ?>+Set the object's value from the stack.
+
+<? glossaryEntry(".PAYLOAD", "( instance class -- address )") ?>+Member holds instance's value.
+
+</dl>
+
+<? glossaryEntry("C-PTR", "") ?>+
+Base class derived from <code>OBJECT</code> for pointers to non-object types.
+This class is not complete by itself: several methods depend on a derived
+class definition of <code>@SIZE</code>. Methods and members:
+
+<dl>
+
+<? glossaryEntry(".ADDR", "( instance class -- a-address )") ?>+Member variable, holds the pointer address.
+
+<? glossaryEntry("GET-PTR", "( instance class -- pointer )") ?>+Pushes the pointer address.
+
+<? glossaryEntry("SET-PTR", "( pointer instance class -- )") ?>+Sets the pointer address.
+
+<? glossaryEntry("INC-PTR", "( instance class -- )") ?>+Adds <code>@SIZE</code> to the pointer address.
+
+<? glossaryEntry("DEC-PTR", "( instance class -- )") ?>+Subtracts <code>@SIZE</code> to the pointer address.
+
+<? glossaryEntry("INDEX-PTR", "( i instance class -- )") ?>+Adds <code>i * @SIZE</code> to the pointer address.
+
+</dl>
+
+<? glossaryEntry("C-BYTEPTR", "") ?>+
+Pointer to byte derived from <code>C-PTR</code>. Methods and members:
+
+<dl>
+
+<? glossaryEntry("@SIZE", "( instance class -- size )") ?>+Push size of the pointed-to object.
+
+<? glossaryEntry("GET", "( instance class -- byte )") ?>+Pushes the pointer's referent byte.
+
+<? glossaryEntry("SET", "( byte instance class -- )") ?>+Stores <code>byte</code> at the pointer address.
+
+</dl>
+
+
+
+<? glossaryEntry("C-2BYTEPTR", "") ?>+
+Pointer to 2byte derived from <code>C-PTR</code>. Methods and members:
+
+<dl>
+
+<? glossaryEntry("@SIZE", "( instance class -- size )") ?>+Push size of the pointed-to object.
+
+<? glossaryEntry("GET", "( instance class -- 2byte )") ?>+Pushes the pointer's referent 2byte.
+
+<? glossaryEntry("SET", "( 2byte instance class -- )") ?>+Stores <code>2byte</code> at the pointer address.
+
+</dl>
+
+
+
+<? glossaryEntry("C-4BYTEPTR", "") ?>+
+Pointer to 4byte derived from <code>C-PTR</code>. Methods and members:
+
+<dl>
+
+<? glossaryEntry("@SIZE", "( instance class -- size )") ?>+Push size of the pointed-to object.
+
+<? glossaryEntry("GET", "( instance class -- 4byte )") ?>+Pushes the pointer's referent 4byte.
+
+<? glossaryEntry("SET", "( 4byte instance class -- )") ?>+Stores <code>4byte</code> at the pointer address.
+
+</dl>
+
+
+<? glossaryEntry("C-CELLPTR", "") ?>+
+Pointer to cell derived from <code>C-PTR</code>. Methods and members:
+
+<dl>
+
+<? glossaryEntry("@SIZE", "( instance class -- size )") ?>+Push size of the pointed-to object.
+
+<? glossaryEntry("GET", "( instance class -- cell )") ?>+Pushes the pointer's referent cell.
+
+<? glossaryEntry("SET", "( cell instance class -- )") ?>+Stores <code>cell</code> at the pointer address.
+
+</dl>
+
+
+
+<? glossaryEntry("C-STRING", "") ?>+
+Dynamically allocated string, similar to MFC's <code>CString</code>.
+For more information, see <code>softcore/string.fr</code>.
+Partial list of methods and members:
+
+<dl>
+
+<? glossaryEntry("GET", "( instance class -- c-address u )") ?>+Pushes the string buffer's contents as a <code>C-ADDR U</code> style string.
+
+<? glossaryEntry("SET", "( c-address u instance class -- )") ?>+Sets the string buffer's contents to a new value.
+
+<? glossaryEntry("CAT", "( c-address u instance class -- )") ?>+Concatenates a string to the string buffer's contents.
+
+<? glossaryEntry("COMPARE", "( c-address u instance class -- result )") ?>+Lexical compiration of a string to the string buffer's contents.
+Return value is the same as the FORTH function <code>COMPARE</code>.
+
+<? glossaryEntry("TYPE", "( instance class -- )") ?>+Prints the contents of the string buffer to the output stream.
+
+<? glossaryEntry("HASHCODE", "( instance class -- i )") ?>+Returns a computed hash based on the contents of the string buffer.
+
+<? glossaryEntry("FREE", "( instance class -- )") ?>+Releases the internal buffer.
+
+</dl>
+
+
+<? glossaryEntry("C-HASHSTRING", "") ?>+
+Subclass of <code>C-STRING</code>, which adds a member variable to store a hashcode.
+For more information, see <code>softcore/string.fr</code>.
+
+</dl>
+
+<? ficlPageFooter() ?>
--- /dev/null
+++ b/doc/source/parsesteps.ht
@@ -1,0 +1,234 @@
+<?
+ficlPageHeader("ficl parse steps")+
+ficlAddToNavBarAs("Parse Steps")+
+def entry(definition):
+ print "<dt>\n<code>" + definition + "</code>\n<dd>\n"
+
+?>
+
+
+<? ficlHeader1("Parse Steps") ?>+
+Unlike every other FORTH we know of, Ficl features an <i>extensible
+parser chain</i>. The Ficl parser is not a monolithic function; instead,
+it is comprised of a simple tokenizer and a series of <i>parse steps</i>.
+A parse step is a step in the parser chain that handles a particular kind
+of token, acting on the token as appropriate. Example parse steps, in
+terms of traditional FORTH lore, would be the "number runner" and the
+"colon compiler".
+<p>
+
+The Ficl parser works like this:
+<ol>
+
+<li>
+Read in a new <i>token</i> (string of text with no internal whitespace).
+
+<li>
+For each parse step in the chain, call the parse step, passing in the token.
+If the parse step returns <code>FICL_TRUE</code>, that parse step must have
+handled the token appropriately; move on to the next token.
+
+<li>
+If the parser tries all the parse steps and none of them return
+<code>FICL_TRUE</code>, the token is illegal—print an error
+and reset the virtual machine.
+
+</ol>
+
+Parse steps can be written as native functions, or as Ficl script functions.
+New parse steps can be appended to the chain at any time.
+
+
+<? ficlHeader2("The Default Ficl Parse Chain") ?>+
+These is the default Ficl parser chain, shown in order.
+
+<dl>
+
+<? entry("?word") ?>+
+If compiling and local variable support is enabled, attempt to find the token in the local
+variable dictionary. If found, execute the token's compilation semantics and return <code>FICL_TRUE</code>.
+<p>
+
+Attempt to find the token in the system dictionary. If found, execute the token's semantics
+(may be different when compiling than when interpreting) and return <code>FICL_TRUE</code>.
+
+<? entry("?prefix") ?>+This parse step is only active if prefix support is enabled, setting <code>FICL_WANT_PREFIX</code>
+in <code>ficl.h</code> to a non-zero value.
+Attempt to match the beginning of the token to the list of known prefixes. If there's a match,
+execute the associated prefix method and return <code>FICL_TRUE</code>.
+
+<? entry("?number") ?>+Attempt to convert the token to a number in the present <code>BASE</code>. If successful, push the
+value onto the stack if interpreting, otherwise compile it, then return <code>FICL_TRUE</code>.
+
+<? entry("?float") ?>+This parse step is only active if floating-point number support is enabled,
+setting <code>FICL_WANT_FLOAT</code> in <code>ficl.h</code> to a non-zero value.
+Attempt to convert the token to a floating-point number. If successful, push the
+value onto the floating-point stack if interpreting, otherwise compile it,
+then return <code>FICL_TRUE</code>.
+
+</dl>
+
+
+
+<? ficlHeader2("Adding A Parse Step From Within Ficl") ?>+<a name=ficlparsestep></a>
+
+You can add a parse step in two ways. The first is to write a Ficl word that
+has the correct stack signature for a parse step:
+<pre>
+<i>MY-PARSE-STEP</i> ( c-addr u -- x*i flag )
+</pre>
+where <code>c-addr u</code> are the address and length of the incoming token,
+and <code>flag</code> is <code>FICL_TRUE</code> if the parse step processed
+the token and <code>FICL_FALSE</code> otherwise.
+<p>
+
+Install the parse step using <code>add-parse-step</code>.
+A trivial example:
+<pre>
+: ?silly ( c-addr u -- flag )
+ ." Oh no! Not another " type cr true ;
+' ?silly add-parse-step
+parse-order
+</pre>
+
+<? ficlHeader2("Adding A Native Parse Step") ?>+
+The other way to add a parse step is to write it in C and add it into the
+parse chain with the following function:
+
+<pre>
+void ficlSystemAddPrimitiveParseStep(ficlSystem *system, char *name, ficlParseStep step);
+</pre>
+
+<code>name</code> is the display name of the parse step in the parse chain
+(as displayed by the Ficl word <code>PARSE-ORDER</code>). <code>step</code>
+is a pointer to the code for the parse step itself,
+and must match the following declaration:
+<pre>
+typedef int (*ficlParseStep)(ficlVm *vm, ficlString s);
+</pre>
+<p>
+
+When a native parse step is run, <code>si</code> points to the incoming token.
+The parse step must return <code>FICL_TRUE</code> if it succeeds in handling the
+token, and <code>FICL_FALSE</code> otherwise.
+See <code>ficlVmParseNumber()</code> in <code>system.c</code> for an example.
+
+
+<? ficlHeader1("Prefixes") ?>+
+What's a prefix, anyway? A prefix (contributed by Larry Hastings) is a token that's
+recognized as the beginning of another token. Its presence modifies the semantics of
+the rest of the token. An example is <code>0x</code>, which causes digits following
+it to be converted to hex regardless of the current value of <code>BASE</code>.
+<p>
+
+Caveat: Prefixes are matched in sequence, so the more of them there are,
+the slower the interpreter gets. On the other hand, because the prefix
+parse step occurs immediately after the dictionary lookup step, if you
+have a prefix for a particular purpose, using it may save time since it
+stops the parse process. Also, the Ficl interpreter is wonderfully fast,
+and most interpretation only happens once, so it's likely you won't notice
+any change in interpreter speed even if you make heavy use of prefixes.
+<p>
+
+Each prefix is a Ficl word stored in a special wordlist called <code><PREFIXES></code>. When the
+prefix parse step (<code>?prefix</code>, implemented in C as <code>ficlVmParsePrefix()</code>) is
+executed, it searches each word in <code><PREFIXES></code> in turn, comparing it with the
+initial characters of the incoming token. If a prefix matches, the parse step returns the remainder
+of the token to the input stream and executes the code associated with the prefix. This code can be
+anything you like, but it would typically do something with the remainder of the token. If the prefix
+code does not consume the rest of the token, it will go through the parse process again (which may
+be what you want).
+<p>
+
+Prefixes are defined in <code>prefix.c</code> and in <code>softcore/prefix.fr</code>.
+The best way to add prefixes is by defining them in your own code, bracketed with the special
+words <code>START-PREFIXES</code> and <code>END-PREFIXES</code>. For example, the following
+code would make <code>.(</code> a prefix.
+
+<pre>
+start-prefixes
+: .( .( ;
+end-prefixes
+</pre>
+<p>
+
+The compile-time constant <code>FICL_EXTENDED_PREFIX</code> controls the inclusion of
+several additional prefixes. This is turned off in the default build, since several
+of these prefixes alter standard behavior, but you might like them.
+
+
+<? ficlHeader1("Notes") ?>+
+<ul>
+
+<li>
+Prefixes and parser extensions are non-standard. However, with the exception of
+prefix support, Ficl's default parse order follows the standard.
+Inserting parse steps in some other order will almost certainly break standard behavior.
+<p>
+
+<li>
+The number of parse steps that can be added to the system is limited by the value of
+<code>FICL_MAX_PARSE_STEPS</code> (defined in <code>sysdep.h</code>). The default
+maximum number is 8.
+<p>
+
+<li>
+The compile-time constant <code>FICL_EXTENDED_PREFIX</code> controls the inclusion of
+several additional prefixes. This is turned off in the default build, since several
+of these prefixes alter standard behavior, but you might like them.
+<p>
+
+
+</ul>
+
+<? ficlHeader1("Parser Glossary") ?>+
+<dl>
+
+<? entry("PARSE-ORDER ( -- )") ?>+
+Prints the list of parse steps, in the order in which they are called.
+
+<? entry("ADD-PARSE-STEP ( xt -- )") ?>+
+Appends a parse step to the parse chain. <code>xt</code> is the address
+(execution token) of a Ficl word to use as the parse step. The word must be a
+legal Ficl parse step (<a href=#ficlparsestep>see above</a>).
+
+<? entry("SHOW-PREFIXES ( -- )") ?>+
+Prints the list of all prefixes. Each prefix is a Ficl word that is executed if its name
+is found at the beginning of a token.
+
+<? entry("START-PREFIXES ( -- )") ?>+
+Declares the beginning of a series of prefix definitions.
+Should be followed, eventually, by <code>END-PREFIXES</code>.
+(All <code>START-PREFIXES</code> does is tell the Ficl virtual machine
+to compile into the <code><PREFIXES></code> wordlist.)
+
+<? entry("END-PREFIXES ( -- )") ?>+
+Declares the end of a series of prefix definitions.
+Should only be used after calling <code>START-PREFIXES</code>.
+(All <code>END-PREFIXES</code> does is tell the Ficl virtual machine
+to switch back to the wordlist that was in use before <code>START-PREFIXES</code> was called.)
+
+</dl>
+
+
+<?
+ficlPageFooter()
+?>
\ No newline at end of file
--- /dev/null
+++ b/doc/source/releases.ht
@@ -1,0 +1,1003 @@
+<?
+ficlPageHeader("ficl release history")+
+ficlAddToNavBarAs("Release History")+
+def ficlVersion(s):
+ ficlHeader1(s)
+
+?>
+
+<? ficlVersion("Version 4.0.31") ?>+<ul>
+
+<li>
+First official release of new engine as Ficl 4! Hooray!
+
+<li>
+<code>ficlDictionarySee()</code> now takes a <code>ficlCallback</code>,
+so it knows where to print to. This is because <b>ficlWin</b> only
+sets a per-VM callback, which <i>should</i> work.
+
+<li>
+<code>ficlSystemCreate()</code> now passes in the system correctly
+into the dictionaries it creates, which lets dictionaries know what
+system they're a part of.
+
+<li>
+ficlCompatibility: Forgot to add the <code>errorTextOut</code> to the
+<code>ficl_system</code> structure (though I'd remembered to add it to
+the <code>ficl_vm</code> structure). This caused the <code>ficl_system</code>
+members after <code>textOut</code> to not line up with their equivalent
+<code>ficlSystem</code> members, which did bad things. (The bad thing
+in particular was calling <code>ficlDictionaryResetSearchOrder()</code>
+resulted in diddling the <code>vm->link</code> member, which strangely
+enough resulted in double-freeing the stacks.)
+
+<li>
+Added <code>ficlStackWalk()</code>, which walks a stack from top
+to bottom and calls your specified callback with each successive
+element. Cleaned up stack-printing functions as a result.
+
+<li>
+Changed <code>MULTICALL</code> so you can explicitly specify the vtable.
+
+<li>
+Changed XClasses so it explicitly specifies the vtable for
+non-virtual classes. This means you can now call a virtual
+method when you've <code>SUPER</code>ed an object and you'll
+get the method you wanted.
+
+<li>
+XClasses improvement: when removing a thunked method, remove
+the thunk variable too. Added <code>xClass.removeMember()</code>
+to support this.
+
+<li>
+XClasses now generates runtime stack-check code (<code>_DEBUG</code>
+only) for functions thunked from C to Ficl.
+
+<li>
+<code>FICL_WANT_PLATFORM</code> is now <code>0</code> by default.
+It is now set to <code>1</code> in the appropriate <code>ficlplatform/*.h</code>.
+
+<li>
+<code>softcore/win32.fr ENVIRONMENT? COMPARE<code> needed to be case-insensitive.
+
+<li>
+Whoops! Setting <code>FICL_PLATFORM_2INTEGER</code> to 0
+didn't compile. It now does, and works fine, as proved by
+the <code>ansi</code> platform.
+
+<li>
+Another whoops: contrib/xclasses/xclasses.py assumed that <code>"</code> (a prefix
+version of <code>S"</code>) defined. Switched to <code>S"</code>, which is safer.
+
+</ul>
+
+<? ficlVersion("Version 4.0.30") ?>+
+<ul>
+
+<li>
+Cleaned up some <code>FICL_</code> definitions. Now all <code>FICL_HAVE_*</code> constants
+(and some other odds and ends) have been moved to <code>FICL_PLATFORM_</code>.
+
+<li>
+Whoops! Setting <code>FICL_PLATFORM_2INTEGER</code> to 0 didn't
+compile. It now does, and works fine, as proved by
+the <code>"ansi"</code> platform.
+
+<li>
+Another whoops: <code>contrib/xclasses/xclasses.py</code> assumed that <code>"</code> (a prefix
+version of <code>S"</code>) defined. Switched to <code>S"</code>, which is safer.
+
+<li>
+Added <code>ficlDictionarySetConstantString()</code>. 'Cause I needed it for:
+
+<li>
+Removed the <code>"WIN32"</code> <code>ENVIRONMENT?</code> setting, and added <code>"FICL_PLATFORM_OS"</code>
+and <code>"FICL_PLATFORM_ARCHITECTURE"</code> in its place. These are both <i>strings</i>.
+Updated <code>softcore/win32.fr</code> to match.
+
+<li>
+Compatibility: improved <code>ficlTextOut()</code> behavior. It makes life slightly
+less convenient for some users, but should be an improvement overall.
+The change: <code>ficlTextOut()</code> is now a compatibility-layer function that
+calls straight through to <code>vmTextOut()</code>. Lots of old code calls <code>ficlTextOut()</code>
+(naughty!). It's now explicit that you must set the <code>textOut</code> function
+by hand if you use a custom one... which is a good habit to get in to anyway.
+
+<li>
+Improved the documentation regarding upgrading, <code>ficllocals.h</code>, and compile-time
+constants.
+
+<li>
+Fixed <code>doc/source/generate.py</code> so it gracefully fails to copy over read-only
+files.
+
+<li>
+Got rid of every <code>#ifdef</code> in the sources. We now consistently use <code>#if defined()</code>
+everywhere. Similarly, got rid of all platform-switched <code>#if</code> code (except for the
+compatibility layer, sigh).
+
+</ul>
+
+<? ficlVersion("Version 4.0.29") ?>+
+<ul>
+
+<li>
+Documentation totally reworked and updated.
+
+<li>
+<code>oldnames</code> renamed to <code>compatibility</code>.
+And improved, so that now Ficl 4 is basically a drop-in
+replacement for Ficl 3.
+
+</ul>
+
+<? ficlVersion("Version 4.0.28") ?>+
+<ul>
+
+<li>
+Did backwards-compatibility testing. Ficl now drops in, more or less,
+with all the old Ficl-3.03-using projects I had handy.
+
+<li>
+Got Ficl compiling and running fine on Linux.
+
+<li>
+Weaned LZ77 code from needing htonl()/ntohl().
+
+<li>
+Moved all the primitives defined in "testmain.c" to their own file,
+"extras.c", and gave it its own global entry point.
+
+<li>
+Renamed "testmain.c" to just plain "main.c".
+
+<li>
+Renamed "softwords" directory to "softcore". More symmetrical.
+
+<li>
+Renamed "softcore\softcore.bat" to "make.bat". Added support for "CLEAN".
+
+</ul>
+
+<? ficlVersion("Version 4.0.27") ?>+<ul>
+
+<li>
+Added runtime jump-to-jump peephole optimization in the new
+switch-threaded VM.
+
+<li>
+Fixed <code>INCLUDE-FILE</code> so it rethrows an exception in the
+subordinate evaluation.
+
+<li>
+Added a separate <code>errorOut</code> function to
+<code>ficlCallback()</code>,
+so under Windows you can have a jolly popup window to
+rub your nose in your failings.
+
+</ul>
+
+<? ficlVersion("Version 4.0.26") ?>+<ul>
+
+<li>
+Namespace policing complete. There are now <i>no</i> external symbols
+which do not start with the word <code>ficl</code>.
+
+<li>
+Removed <code>ficlVmExec()</code>, renamed <code>ficlVmExecC()</code> to
+<code>ficlVmExecuteString()</code>, changed it to take a <code>ficlString()</code>.
+This is deliberate subterfuge on my part; I suspect most
+people who currently call <code>ficlVmExec() / ficlVmExecC()</code>
+should be calling <code>ficlVmEvaluate()</code>.
+</ul>
+
+<? ficlVersion("Version 4.0.25") ?>+<ul>
+
+<li>
+First pass at support for "oldnames", and namespace policing.
+
+</ul>
+
+<? ficlVersion("Version 4.0.23") ?>+First alpha release of Ficl 4.0 rewrite. Coded, for better
+or for worse, by Larry Hastings.
+Ficl is <i>smaller</i>, <i>faster</i>, <i>more powerful</i>,
+and <i>easier to use</i> than ever before. (Or your money back!)
+<ul>
+<li>
+Rewrote Ficl's virtual machine; Ficl now runs nearly 3x faster out-of-the-box.
+The new virtual machine is of the "big switch statement" variety.
+
+<li>
+Renamed most (probably all) external Ficl functions and data structures.
+They now make sense and are (gasp!) consistent.
+
+<li>
+Retooled double-cell number support to take advantage of platforms
+which natively support double-cell-sized integers. (Like most modern
+32-bit platforms.)
+
+<li>
+Locals and VALUEs are now totally orthogonal; they can be single- or
+double-cell, and use the float or data stack. TO automatically supports all variants.
+
+<li>
+The "softcore" words can now be stored compressed, with a (current)
+savings of 11k. Decompression is nigh-instantaneous. You can choose
+whether or not you want softcore stored compressed at compile-time.
+
+<li>
+Reworked Win32 build process. Ficl now builds out-of-the-box on Win32
+as a static library, as a DLL, and as a command-line program,
+in each of the six possible runtime variants (Debug,Release x Singlethreaded,
+Multithreaded,Multithreaded DLL).
+
+<li>
+There's very likely other wonderful things that I've long forgotten
+about. If you notice them, feel free to remind me :)
+
+</ul>
+
+<? ficlVersion("Version 3.03") ?>+<ul>
+<li>
+Bugfix for floating-point numbers. Floats in compiled code were simply broken.
+
+<li>
+New words: <code>random</code> and <code>seed-random</code>
+
+<li>
+Bugfix: <code>included</code> never closed its file.
+
+<li>
+Bugfix: <code>include</code> was not <code>IMMEDIATE</code>.
+
+<li>
+Un-hid the OO words <code>parse-method</code>, <code>lookup-method</code>, and <code>find-method-xt</code>, as there are perfectly legitimate reasons why you might want to use them.
+
+<li>
+Changed the prefix version of <code>.(</code> to be <code>IMMEDIATE</code> too.
+
+<li>
+Fixed comment in Python softcore builder.
+
+<li>
+Put the <b>doc</b> directory back in to the distribution. (It was missing from 3.02... where'd it go?)
+
+</ul>
+
+
+
+<? ficlVersion("Version 3.02") ?>+<ul>
+<li>
+Added support for <code>nEnvCells</code> (number of environment cells) to <code>FICL_SYSTEM_INFO</code>.
+
+<li>
+Consolidated <code>context</code> and <code>pExtend</code> pointers of <code>FICL_SYSTEM</code>—VM's <code>pExtend</code> pointer is initialized from the copy in <code>FICL_SYSTEM</code> upon VM creation.
+
+<li>
+Added <code>ficl-robust</code> environment variable.
+
+<li>
+Added <code>FW_ISOBJECT</code> word type.
+
+<li>
+Bugfix: <code>environment?</code> was ignoring the length of the supplied string.
+
+<li>
+Portability cleanup in fileaccess.c.
+
+<li>
+Bugfix in <code>ficlParsePrefix</code>: if the prefix dictionary isn't in the wordlist, the word being examined cannot be a prefix, so return failure.
+
+<li>
+<code>SEE</code> improvements: <code>SEE</code> (and consequently <code>DEBUG</code>) have improved source listings with instruction offsets.
+
+<li>
+It's turned off with the preprocessor, but we have the beginnings of a switch-threaded implementation of the inner loop.
+
+<li>
+Added <code>objectify</code> and <code>?object</code> for use by OO infrastructure.
+
+<li>
+<code>my=[</code> detects object members (using <code>?object</code>) and assumes all other members leave class unchanged.
+
+<li>
+Removed <code>MEMORY-EXT</code> environment variable (there is no such wordset).
+
+<li>
+Ficlwin changes:
+<ul>
+<li>
+Ficlwin character handling is more robust
+
+<li>
+Ficlwin uses multi-system constructs (see ficlthread.c)
+
+</ul>
+
+<li>
+Documentation changes:
+<ul>
+<li>
+Corrected various bugs in docs.
+
+<li>
+Added ficl-ized version of JV Noble's Forth Primer
+
+<li>
+Ficl OO tutorial expanded and revised. Thanks to David McNab for his demo and suggestions.
+
+</ul>
+
+
+</ul>
+
+<? ficlVersion("Version 3.01") ?>+<ul>
+<li>
+Major contributionss by Larry Hastings ([email protected]):
+<ul>
+<li>
+FILE wordset (fileaccess.c)
+
+<li>
+ficlEvaluate wrapper for ficlExec
+
+<li>
+ficlInitSystemEx makes it possible to bind selectable properties to VMs at create time
+
+<li>
+Python version of softcore builder ficl/softwords/softcore.py
+
+</ul>
+
+<li>
+Environment contains ficl-version (double)
+
+<li>
+?number handles trailing decimal point per DOUBLE wordset spec
+
+<li>
+Fixed broken .env (thanks to Leonid Rosin for spotting this goof)
+
+<li>
+Fixed broken floating point words that depended on evaluation order of stack pops.
+
+<li>
+env-constant
+
+<li>
+env-2constant
+
+<li>
+dictHashSummary is now commented out unless FICL_WANT_FLOAT (thanks to Leonid Rosin again)
+
+<li>
+Thanks to David McNab for pointing out that .( should be IMMEDIATE. Now it is.
+
+</ul>
+
+<? ficlVersion("Version 3.00a") ?>+
+<ul>
+<li>
+Fixed broken oo.fr by commenting out vcall stuff using FICL_WANT_VCALL. Vcall is still broken.
+
+</ul>
+
+<? ficlVersion("Version 3.00") ?>+
+<ul>
+<li>
+Added pSys parameter to most ficlXXXX functions for multiple system support. Affected functions:
+<ul>
+<li>dictLookupLoc renamed to ficlLookupLoc after addition of pSys param
+<li>ficlInitSystem returns a FICL_SYSTEM*
+<li>ficlTermSystem
+<li>ficlNewVM
+<li>ficlLookup
+<li>ficlGetDict
+<li>ficlGetEnv
+<li>ficlSetEnv
+<li>ficlSetEnvD
+<li>ficlGetLoc
+<li>ficlBuild
+</ul>
+
+
+<li>Fixed off-by-one bug in ficlParsePrefix
+<li>Ficl parse-steps now work correctly - mods to interpret()
+<li>Made tools.c:isAFiclWord more selective
+<li>Tweaked makefiles and code to make gcc happy under linux
+<li>Vetted all instances of LVALUEtoCELL to make sure they're working on CELL sized operands
+(for 64 bit compatibility)
+</ul>
+
+<? ficlVersion("Version 2.06") ?>+<ul>
+<li>Debugger changes:
+<ul>
+<li>New debugger command "x" to execute the rest of the command line as ficl
+<li>New debugger command "l" lists the source of the innermost word being debugged
+<li>If you attempt to debug a primitive, it gets executed rather than doing nothing
+<li><code>R.S</code> displays the stack contents symbolically
+<li>Debugger now operates correctly under ficlwin, although ficlwin's key handling leaves a lot to be desired.
+<li><code>SEE</code> listing enhanced for use with the debugger
+</ul>
+<li>Added Guy Carver's changes to oo.fr for VTABLE support
+<li><code>float.c</code> words f> and >f to move floats to and from the param stack, analogous to >r and r>
+<li><code>LOOKUP</code> - Surrogate precompiled parse step for ficlParseWord (this step is hard
+ coded in <code>INTERPRET</code>)
+<li>License text at top of source files changed from LGPL to BSD by request
+<li>Win32 console version now handles exceptions more gracefully rather than crashing - uses win32
+structured exception handling.
+<li>Fixed BASE bug from 2.05 (was returning the value rather than the address)
+<li>Fixed ALLOT bug - feeds address units to dictCheck, which expects Cells. Changed dictCheck
+to expect AU.
+<li>Float stack display word renamed to f.s from .f to be consistent with r.s and .s
+</ul>
+
+<? ficlVersion("Version 2.05") ?>+<h3>General</h3>
+
+<ul>
+<li>HTML documentation extensively revised
+<li>Incorporated Alpha (64 bit) patches from the freeBSD team.
+<li>Split SEARCH and SEARCH EXT words from words.c to search.c
+<li><a href="ficl_loc.html">2LOCALS</a> defined in <a href="ficl_loc.html#jhlocal">Johns Hopkins local syntax</a> now lose the first '2:' in their names.
+<li>Simple step <a href="ficl_debug.html">debugger</a> (see tools.c)
+<li>The text interpreter is now extensible - this is accomplished through the use
+of <code>ficlAddParseStep()</code>. <code>FICL_MAX_PARSE_STEPS</code> limits the number of parse steps
+(default: 8). You can write a precompiled parse step (see <code>ficlParseNumber</code>) and
+append it to the chain, or you can write one in ficl and use <code>ADD-PARSE-STEP</code>
+to append it. Default parse steps are initialized in <code>ficlInitSystem</code>. You can list
+the parse steps with <code>parse-order ( -- )</code>.
+<li>There is now a FICL_SYSTEM structure. This is a transitional release - version 3.0
+will alter several API prototypes to take this as a parameter, allowing multiple
+systems per process (and therefore multiple dictionaries). For those who use ficl
+under a virtual memory O/S like Linux or Win NT, you can just create multiple ficl
+processes (not threads) instead and save youself the wait.
+<li>Fixes for improved command line operation in testmain.c (Larry Hastings)
+<li>Numerous extensions to OO facility, including a new allot methods, ability
+to catch method invocations (thanks to Daniel Sobral again)
+<li>Incorporated Alpha (64 bit) patches contributed by Daniel Sobral and the freeBSD team
+Ficl is now 64 bit friendly! UNS32 is now FICL_UNS.
+<li>Split SEARCH and SEARCH EXT words from words.c to search.c
+<li>ABORT" now complies with the ANS (-2 THROWs)
+<li>Floating point support contributed by Guy Carver (Enable FICL_WANT_FLOAT in sysdep.h).
+<li>Win32 vtable model for objects (Guy Carver)
+<li>Win32 dll load/call suport (Larry Hastings)
+<li>Prefix support (Larry Hastings) (prefix.c prefix.fr FICL_EXTENDED_PREFIX) makes it
+easy to extend the parser to recignize prefixes like 0x and act on them. Use show-prefixes
+to see what's defined.
+<li>Cleaned up initialization sequence so that it's all in ficlInitSystem, and so that
+a VM can be created successfully before the dictionary is created
+</ul>
+
+<h3>
+Bug fixes</h3>
+
+<ul>
+<li>
+<a href="http://www.taygeta.com/forth/dpans9.htm#9.6.2.0680">ABORT"</a>
+now works correctly (I promise!)
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans6.htm#6.2.2125">REFILL</a> works
+better
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans6.htm#6.1.0710">ALLOT</a>'s
+use of dictCheck corrected (finally)
+</ul>
+
+<h3>
+New words</h3>
+
+<ul>
+<li>
+<a href="http://www.taygeta.com/forth/dpans6.htm#6.2.0415">2r@</a> <a href="http://www.taygeta.com/forth/dpans6.htm#6.2.0410">2r></a> <a href="http://www.taygeta.com/forth/dpans6.htm#6.2.0340">2>r</a>
+(CORE EXT)
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans8.htm#8.6.1.0440">2VARIABLE</a>
+(DOUBLE)
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans16.htm#16.6.2.1985">ORDER</a>
+now lists wordlists by name
+
+<li>
+<a href="http://www.taygeta.com/forth/dpans15.htm#15.6.1.0220">.S</a> now
+displays all stack entries on one line, like a stack comment
+
+<li>
+<a href="ficl.html#wid-get-name"><tt>wid-get-name</tt> </a>
+given a wid, returns the address and count of its name. If no name, count
+is 0
+
+<li>
+<tt><a href="ficl.html#wid-set-name">wid-set-name</a></tt>
+set optional wid name pointer to the \0 terminated string address specified.
+
+<li>
+<tt><a href="ficl.html#ficlwordlist">ficl-named-wordlist</a></tt> creates
+a ficl-wordlist and names it. This is now used in <tt>vocabulary</tt> and
+<tt><a href="ficl.html#ficlvocabulary">ficl-vocabulary</a></tt>
+
+<li>
+<tt><a href="ficl.html#last-word">last-word</a></tt> returns the
+xt of the word being defined or most recently defined.
+
+<li>
+<tt><a href="ficl.html#qfetch">q@</a></tt> and <tt><a href="ficl.html#qbang">q!</a></tt>
+operate on quadbyte quantities for 64 bit friendliness
+</ul>
+
+<h3>
+New OO stuff</h3>
+
+<ul>
+<li>
+<tt>ALLOT (class method)</tt>
+
+<li>
+<tt>ALLOT-ARRAY (class method)</tt>
+
+<li>
+<tt>METHOD</tt> define method names globally
+
+<li>
+<tt>MY=></tt> early bind a method call to "this" class
+
+<li>
+<tt>MY=[ ]</tt> early bind a string of method calls to "this" class and
+obj members
+
+<li>
+<tt>C-></tt> late bind method invocation with CATCH
+
+<li>
+Metaclass method <tt>resume-class</tt> and instance word <tt>suspend-class</tt>
+create mutually referring classes. Example in string.fr
+
+<li>
+Early binding words are now in the instance-vars wordlist, not visible
+unless defining a class.
+
+<li>Support for refs to classes with VTABLE methods (contributed by Guy Carver). Guy writes:
+<p>
+My next favorite change is a set of VCALL words that allow me
+to call C++ class virtual methods from my forth classes. This
+is accomplished by interfacing with the VTABLE of the class. The
+class instance currently must be created on the C++ side.
+C++ places methods in the VTABLE in order of declaration in the
+header file. To use this in FICL one only needs to ensure
+that the VCALL: declerations occur in the same order. I use this
+quite a bit to interface with the C++ classes. When I need access
+to a method I make sure it is virtual (Even if it ultimately will
+not be). I use Visual C++ 6.0 and have not tested this under
+any other compiler but I believe VTABLE implementation is standard.
+</p><p>
+Here is an example of how to use VCALL:
+</p>
+<b>C++ class declaration</b>
+<pre>
+class myclass
+{+public:
+ myclass();
+ virtual ~myclass();
+ virtual void Test( int iParam1 );
+ virtual int Test( int iParam1, char cParam2 );
+ virtual float Test();
+};
+</pre>
+<b>ficl class declaration</b>
+<pre>
+object subclass myfclass hasvtable \ hasvtable adds 4 to the offset to
+ \ accommodate for the VTABLE pointer.
+0 VCALL: Destructor() \ VCALL: ( ParamCount -<MethodName>- )
+1 VCALL: Test(int) \ Test takes 1 int parameter.
+2 VCALLR: iTest(int,char) \ iTest takes 2 parameters and returns an int.
+0 VCALLF: fTest() \ fTest takes no parameters and returns a float.
+end-class
+
+MyCAddress \ Primitive to return a pointer to a "myclass" instance.
+myfclass -> ref dude \ This makes the MyCAddress pointer a myfclass
+ \ instance with the name "dude".
+1234 dude -> Test(int) \ Calls the virtual method Test.
+1234 1 dude -> iTest(int,char) . \ Calls iTest and emits the returned int.
+dude -> fTest() f. \ Calls fTest and emits the returned float.
+</pre>
+
+</ul>
+
+<? ficlVersion("Version 2.04") ?>+
+<h3>ficlwin</h3>
+
+<ul>
+<li>
+Catches exceptions thrown by VM in ficlThread (0 @ for example) rather
+than passing them off to the OS.
+</ul>
+
+<h3>
+ficl bugs vanquished</h3>
+
+<ul>
+<li>
+Fixed leading delimiter bugs in s" ." .( and ( (reported by Reuben Thomas)
+
+<li>
+Makefile tabs restored (thanks to Michael Somos)
+
+<li>
+ABORT" now throws -2 per the DPANS (thanks to Daniel Sobral for sharp eyes
+again)
+
+<li>
+ficlExec does not print the prompt string unless (source-id == 0)
+
+<li>
+Various fixes contributed by the FreeBSD team.
+</ul>
+
+<h3>
+ficl enhancements</h3>
+
+<ul>
+<li>
+Words.c: modified ficlCatch to use vmExecute and vmInnerLoop (request of
+Daniel Sobral) Added vmPop and vmPush functions (by request of Lars Krueger
+) in vm.c These are shortcuts to the param stack. (Use LVALUEtoCELL to
+get things into CELL form)
+
+<li>
+Added function vmGetStringEx with a flag to specify whether or not to skip
+lead delimiters
+
+<li>
+Added non-std word: number?
+
+<li>
+Added CORE EXT word AGAIN (by request of Reuben Thomas)
+
+<li>
+Added double cell local (2local) support
+
+<li>
+Augmented Johns Hopkins local syntax so that locals whose names begin with
+char 2 are treated as 2locals (OK - it's goofy, but handy for OOP)
+
+<li>
+C-string class revised and enhanced - now dynamically sized
+
+<li>
+C-hashstring class derived from c-string computes hashcode too.
+</ul>
+
+
+<? ficlVersion("Version 2.03") ?>+
+This is the first version of Ficl that includes contributed code. Thanks
+especially to Daniel Sobral, Michael Gauland for contributions and bug
+finding.
+<p>
+New words:
+<ul>
+<li>
+<tt><a href="#clock">clock</a>
+(FICL)</tt>
+
+<li>
+<tt><a href="#clockspersec">clocks/sec</a>
+(FICL)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans8.htm#8.6.1.1230">dnegate</a>
+(DOUBLE)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans10.htm#10.6.2.1905">ms</a>
+(FACILITY EXT - replaces MSEC <i>ficlWin only</i>)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans9.htm#9.6.1.2275">throw</a>
+(EXCEPTION)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans9.htm#9.6.1.0875">catch</a>
+(EXCEPTION)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans14.htm#14.6.1.0707">allocate</a>
+(MEMORY)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans14.htm#14.6.1.1605">free</a>
+(MEMORY)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans14.htm#14.6.1.2145">resize</a>
+(MEMORY)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans6.htm#6.2.2440">within</a>
+(CORE EXT)</tt>
+
+<li>
+<tt><a href="#alloc">alloc</a>
+(class method)</tt>
+
+<li>
+<tt><a href="#allocarray">alloc-array</a>
+(class method)</tt>
+
+<li>
+<tt><a href="#oofree">free</a>
+(class method)</tt>
+</ul>
+
+Bugs Fixed:
+<ul>
+<li>
+Bug fix in isNumber(): used to treat chars between 'Z' and 'a' as valid
+in base 10... (harmless, but weird)
+
+<li>
+ficlExec pushes the <i>ip</i> and <tt>interpret</tt>s at the right times
+so that nested calls to ficlExec behave the way you'd expect them to.
+
+<li>
+<tt>evaluate</tt> respects count parameter, and also passes exceptional
+return conditions back out to the calling instance of ficlExec.
+
+<li>
+VM_QUIT now clears the locals dictionary in ficlExec.
+</ul>
+Ficlwin Enhancements
+<ul>
+<li>
+File Menu: recent file list and Open now load files.
+
+<li>
+Text ouput function is now faster through use of string caching. Cache
+flushes at the end of each line and each time ficlExec returns.
+
+<li>
+Edit/paste now behaves more reasonably for text. File/open loads the specified
+file.
+
+<li>
+Registry entries specify dictionary and stack sizes, default window placement,
+and whether or not to create a splitter for multiple VMs. See HKEY_CURRENT_USER/Software/CodeLab/ficlwin/Settings
+</ul>
+Ficl Enhancements
+<ul>
+<li>
+This version includes changes to make it <b>64 bit friendly</b>. This unfortunately
+meant that I had to tweak some core data types and structures. I've tried
+to make this transparent to 32 bit code, but a couple of things got renamed.
+INT64 is now DPINT. UNS64 is now DPUNS. FICL_INT and FICL_UNS are synonyms
+for INT32 and UNS32 in 32 bit versions, but a are obsolescent. Please use
+the new data types instead. Typed stack operations on INT32 and UNS32 have
+been renamed because they operate on CELL scalar types, which are 64 bits
+wide on 64 bit systems. Added BITS_PER_CELL, which has legal values of
+32 or 64. Default is 32.
+
+<li>
+ficl.c: Added ficlExecXT() - executes an xt completely before returning,
+passing back any exception codes generated in the process. Normal exit
+code is VM_INNEREXIT.
+
+<li>
+ficl.c: Added ficlExecC() to operate on counted strings as opposed to zero
+terminated ones.
+
+<li>
+ficlExec pushes ip and executes interpret at the right times so that nested
+calls to ficlExec behave the way you'd expect them to.
+
+<li>
+ficlSetStackSize() allows specification of stack size at run-time (affects
+subsequent invocations of ficlNewVM()).
+
+<li>
+vm.c: vmThrow() checks for (pVM->pState != NULL) before longjmping it.
+vmCreate nulls this pointer initially.
+
+<li>
+EXCEPTION wordset contributed by Daniel Sobral of FreeBSD
+
+<li>
+MEMORY-ALLOC wordset contributed by Daniel Sobral, too. Added class methods
+<tt>alloc</tt>
+and <tt>alloc-array</tt> in softwords/oo.fr to allocate objects from the
+heap.
+
+<li>
+Control structure match check upgraded (thanks to Daniel Sobral for this
+suggestion). Control structure mismatches are now errors, not warnings,
+since the check accepts all syntactally legal constructs.
+
+<li>
+Added vmInnerLoop() to vm.h. This function/macro factors the inner
+interpreter out of ficlExec so it can be used in other places. Function/macro
+behavior is conditioned on INLINE_INNER_LOOP in sysdep.h. Default: 1 unless
+_DEBUG is set. In part, this is because VC++ 5 goes apoplectic when trying
+to compile it as a function. See
+
+<br>comments in vm.c
+<li>
+EVALUATE respects the count parameter, and also passes exceptional return
+conditions back out to the calling instance of ficlExec.
+
+<li>
+VM_QUIT clears locals dictionary in ficlExec()
+
+<li>
+Added Michael Gauland's ficlLongMul and ficlLongDiv and support routines
+to math64.c and .h. These routines are coded in C, and are compiled only
+if PORTABLE_LONGMULDIV == 1 (default is 0).
+
+<li>
+Added definition of ficlRealloc to sysdep.c (needed for memory allocation
+wordset). If your target OS supports realloc(), you'll probably want to
+redefine ficlRealloc in those terms. The default version does ficlFree
+followed by ficlMalloc.
+
+<li>
+testmain.c: Changed gets() in testmain to fgets() to appease the security
+gods.
+
+<li>
+testmain: <tt>msec</tt> renamed to <tt><a href="#ficlms">ms</a></tt> in
+line with the ANS
+
+<li>
+softcore.pl now removes comments & spaces at the start and end of lines.
+As a result: sizeof (softWords) == 7663 bytes (used to be 20000)
+and consumes 11384 bytes of dictionary when compiled
+
+<li>
+Deleted license paste-o in readme.txt (oops).
+</ul>
+
+
+<? ficlVersion("Version 2.02") ?>+
+New words:
+<ul>
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans6.htm#6.2.1850">marker</a>
+(CORE EXT)</tt>
+
+<li>
+<tt><a href="http://www.taygeta.com/forth/dpans15.htm#15.6.2.1580">forget</a>
+(TOOLS EXT)</tt>
+
+<li>
+<tt><a href="#ficlforgetwid">forget-wid</a>
+(FICL)</tt>
+
+<li>
+<tt><a href="#ficlwordlist">ficl-wordlist</a> (FICL)</tt>
+
+<li>
+<tt><a href="#ficlvocabulary">ficl-vocabulary</a> (FICL)</tt>
+
+<li>
+<tt><a href="#ficlhide">hide</a>
+(FICL)</tt>
+
+<li>
+<tt><a href="#ficlhidden">hidden</a>
+(FICL)</tt>
+
+<li>
+<a href="#jhlocal">Johns Hopkins local variable syntax</a> (as best I can
+determine)
+</ul>
+Bugs Fixed
+<ul>
+<li>
+<tt>forget</tt> now adjusts the dictionary pointer to remove the name of
+the word being forgotten (name chars come before the word header in ficl's
+dictionary)
+
+<li>
+<tt>:noname</tt> used to push the colon control marker and its execution
+token in the wrong order
+
+<li>
+<tt>source-id</tt> now behaves correctly when loading a file.
+
+<li>
+<tt>refill</tt> returns zero at EOF (Win32 load). Win32 <tt><a href="#ficlload">load</a></tt>
+command continues to be misnamed. Really ought to be called <tt>included</tt>,
+but does not exactly conform to that spec either (because <tt>included</tt>
+expects a string signature on the stack, while Ficl's <tt><a href="#ficlload">load</a></tt>
+expects a filename upon invocation). The "real" <tt>LOAD</tt> is a <tt>BLOCK</tt>
+word.
+</ul>
+Enhancements (IMHO)
+<ul>
+<li>
+dictUnsmudge no longer links anonymous definitions into the dictionary
+
+<li>
+<tt>oop</tt> is no longer the default compile wordlist at startup, nor
+is it in the search order. Execute <b><tt>also oop definitions</tt></b>
+to use Ficl OOP.
+
+<li>
+Revised oo.fr extensively to make more use of early binding
+
+<li>
+Added <tt>meta</tt> - a constant that pushes the address of metaclass.
+See oo.fr for examples of use.
+
+<li>
+Added classes: <tt>c-ptr c-bytePtr c-2bytePtr c-cellPtr
+</tt>These
+classes model pointers to non-object data, but each knows the size of its
+referent.
+</ul>
+
+
+<? ficlVersion("Version 2.01") ?>+
+<ul>
+<li>
+Bug fix: <tt>(local)</tt> used to leave a value on the stack between the
+first and last locals declared. This value is now stored in a static.
+
+<li>
+Added new local syntax with parameter re-ordering. <a href="#newlocal">See
+description below</a>. (No longer compiled in version 2.02, in favor of
+the Johns Hopkins syntax)
+</ul>
+
+
+<? ficlVersion("Version 2.0") ?>+
+<ul>
+<li>
+New ANS Forth words: <tt>TOOLS</tt> and part of <tt>TOOLS EXT, SEARCH</tt>
+and <tt>SEARCH EXT, LOCALS</tt> and <tt>LOCALS EXT</tt> word sets, additional
+words from <tt>CORE EXT, DOUBLE</tt>, and <tt>STRING</tt>. (See the function
+ficlCompileCore in words.c for an alphabetical list by word set).
+
+<li>
+Simple <tt>USER</tt> variable support - a user variable is a virtual machine
+instance variable. User variables behave as <tt>VARIABLE</tt>s in all other
+respects.
+
+<li>
+Object oriented syntax extensions (see below)
+
+<li>
+Optional stack underflow and overflow checking in many CORE words (enabled
+when FICL_ROBUST >= 2)
+
+<li>
+Various bug fixes
+</ul>
+
+
+
+<? ficlPageFooter() ?>
--- /dev/null
+++ b/doc/source/upgrading.ht
@@ -1,0 +1,349 @@
+<?
+
+ficlPageHeader("upgrading ficl")+
+ficlAddToNavBarAs("Upgrading To 4.0")+
+def startoldvsnew(extra = None):
+ print "<table width=100%><tr>\n"
+ print "<td bgcolor=#d0d0f0><b>old name</b></td>\n"
+ print "<td bgcolor=#e0e0ff><b>new name</td>\n"
+ if extra != None:
+ print "<td bgcolor=#d0d0f0><b>" + extra + "</td>\n"
+ print "</tr>\n"
+
+def oldvsnew(old, new, extra = None):
+ print "<tr>\n"
+ print "<td bgcolor=#e0e0e0><code>" + old + "</code></td>\n"
+ print "<td bgcolor=#f0f0f0><code>" + new + "</code></td>\n"
+ if extra != None:
+ print "<td bgcolor=#e0e0e0><code>" + extra + "</code></td>\n"
+ print"</tr>\n\n"
+
+
+def endoldvsnew():
+ print "</table><p>\n"
+
+?>
+
+Ficl 4.0 is smaller, faster, and more capable than any previous
+version. For more information on why Ficl 4.0 is so gosh-darned
+swell, see the <a href=index.html#WhatsNewInFicl4.0>What's New In Ficl 4.0?</a>
+section of the overview.
+<p>
+
+
+Since the Ficl API has changed so dramatically, you can't just drop
+the new Ficl source. You have two basic choices:
+<a href=#compatibility>use the <code>FICL_WANT_COMPATIBILITY</code> support</a>, and
+<a href=#newapi>switching to the new API</a>.
+<p>
+
+Note that using <i>either</i> of these choices <i>requires</i>
+that you recompile your application. You cannot build Ficl 4 into
+a shared library or DLL and use it with an application expecting
+Ficl 3.0. Stated another way: Ficl 4 is <i>source</i> compatible
+but not <i>binary</i> compatible with Ficl 3.
+
+
+<a name=oldnames>
+<? ficlHeader1("Using <code>FICL_WANT_COMPATIBILITY</code>") ?>+</a>
+
+
+If you want to get Ficl 4.0 up and running in your project as quickly
+as possible, <code>FICL_WANT_COMPATIBILITY</code> is what you'll want to use.
+There are two easy steps, one of which you might be able to skip:
+<p>
+
+<ol>
+
+<li>
+Set the C preprocessor constant <code>FICL_WANT_COMPATIBILITY</code> to 1.
+The best way is by adding the following line to <code>ficllocal.h</code>:
+<pre>
+ #define FICL_WANT_COMPATIBILITY (1)
+</pre>
+
+
+<li>
+
+<i>If</i> you use a custom <code>ficlTextOut()</code> function, you'll
+have to rename it, and explicitly specify it to Ficl. Renaming it is
+necessary, because the Ficl compatibility layer also provides one for
+code that called <code>ficlTextOut()</code> directly (instead of calling
+<code>vmTextOut()</code> as it should have).
+We recommend renaming your function to <code>ficlTextOutLocal()</code>, as
+we have have provided a prototype for this function for you in <code>ficlcompatibility.h</code>.
+This will save you the trouble of defining your own prototype, ensuring you get
+correct name decoration / linkage, etc.
+
+<p>
+
+There are two methods you can use to specify your <code>ficlTextOut()</code>
+function:
+<ol>
+
+<li>
+Specify it in the <code>FICL_INIT_INFO</code> structure passed in to
+<code>ficlInitSystem()</code>. This is the preferred method, as it ensures
+you will see the results of Ficl's initialization code, and it will be
+automatically passed in to every newly created VM.
+
+<li>
+Set it explicitly in every VM by calling <code>vmSetTextOut()</code> and
+passing it in.
+
+</ol>
+<p>
+
+<b>Note:</b> Any other method, such as setting it by hand in the
+<code>FICL_SYSTEM</code> or <code>FICL_VM</code> structures,
+will <b>not</b> work. There is a special compatibility layer for old-style
+<code>OUTFUNC</code> functions, but it is only invoked properly when you
+use one of the two methods mentioned above.
+
+
+</ol>
+
+<p>
+
+This <i>should</i> be sufficient for you to recompile-and-go
+with Ficl 4. If it's not, please let us know, preferably including a
+suggested solution to the problem.
+
+
+<a name=newapi>
+<? ficlHeader1("Using The New API") ?>+</a>
+
+Since most (all?) of the external symbols have changed names since the 3.0 series,
+here is a quick guide to get you started on renaming everything. This is by no
+means an exhaustive list; this is meant to guide you towards figuring out what
+the new name <i>should</i> be. (After all, part of the point of this massive
+renaming was to make all the external symbols consistent.)
+<p>
+
+
+
+
+<? ficlHeader2("Types") ?>+
+Every external type has been renamed. They all begin with the
+word <code>ficl</code>, and they use mixed case (instead of all upper-case,
+which is now reserved for macros). Also, the confusingly-named
+string objects have been renamed:
+<code>FICL_STRING</code> is now <code>ficlCountedString</code>, as it
+represents a "counted string" in the language, and
+the more commonly-used <code>STRINGINFO</code> is now simply
+<code>ficlString</code>.
+
+<?
+
+startoldvsnew()
+
+oldvsnew("FICL_SYSTEM", "ficlSystem")+oldvsnew("FICL_VM", "ficlVm")+oldvsnew("FICL_SYSTEM_INFO", "ficlSystemInformation")+oldvsnew("FICL_WORD", "ficlWord")+oldvsnew("IPTYPE", "ficlIp")+oldvsnew("FICL_CODE", "ficlPrimitive")+oldvsnew("OUTFUNC", "ficlOutputFunction")+oldvsnew("FICL_DICTIONARY", "ficlDictionary")+oldvsnew("FICL_STACK", "ficlStack")+oldvsnew("STRINGINFO", "ficlString")+oldvsnew("FICL_STRING", "ficlCountedString")+
+endoldvsnew()
+
+?>
+
+<? ficlHeader2("Structure Members") ?>+
+In addition, many structure names have changed. To help ease the heartache,
+we've also added some accessor macros. So, in case they change in the future,
+your code might still compile (hooray!).
+<?
+
+startoldvsnew("accessor")+
+oldvsnew("pExtend", "context", "ficlVmGetContext(), ficlSystemGetContext()")+oldvsnew("pStack", "dataStack", "ficlVmGetDataStack()")+oldvsnew("fStack", "floatStack", "ficlVmGetFloatStack()")+oldvsnew("rStack", "returnStack", "ficlVmGetReturnStack()")+
+endoldvsnew()
+
+?>
+
+<? ficlHeader2("Callback Functions") ?>+
+Text output callbacks have changed in two major ways:
+
+<ul>
+
+<li>
+They no longer take a VM pointer; they now take a <code>ficlCallback</code> structure.
+This allows output to be printed before a VM is defined, or in circumstances where a
+VM may not be defined (such as an assertion failure in a <code>ficlSystem...()</code> function).
+
+<li>
+They no longer take a flag indicating whether or not to add a "newline".
+Instead, the function must output a newline whenever it encounters
+a <code>\n</code> character in the text.
+
+</ul>
+
+If you don't want to rewrite your output function yet, you can
+"thunk" the new-style call to the old-style. Just pass in <code>ficlOldnamesCallbackTextOut</code>
+as the name of the output function for the system and VM, and then set
+the <code>thunkedTextout</code> member of the <code>ficlSystem</code>
+or <code>ficlVm</code> to your old-style text output function.
+
+
+<? ficlHeader2("Renamed Macros") ?>+
+<?
+
+startoldvsnew()
+
+oldvsnew("PUSHPTR(p)", "ficlStackPushPointer(vm->dataStack, p)")+oldvsnew("POPUNS()", "ficlStackPopUnsigned(vm->dataStack)")+oldvsnew("GETTOP()", "ficlStackGetTop(vm->dataStack)")+
+oldvsnew("FW_IMMEDIATE", "FICL_WORD_IMMEDIATE")+oldvsnew("FW_COMPILE", "FICL_WORD_COMPILE_ONLY")+
+oldvsnew("VM_INNEREXIT", "FICL_VM_STATUS_INNER_EXIT")+oldvsnew("VM_OUTOFTEXT", "FICL_VM_STATUS_OUT_OF_TEXT")+oldvsnew("VM_RESTART", "FICL_VM_RESTART")+
+
+endoldvsnew()
+
+?>
+
+<? ficlHeader2("<code>ficllocal.h</code>") ?>+
+One more note about macros. Ficl now ships with a standard place for
+you to tweak the Ficl compile-time preprocessor switches such as
+<code>FICL_WANT_COMPATIBILITY</code> and <code>FICL_WANT_FLOAT</code>.
+It's a file called <code>ficllocal.h</code>, and we guarantee that it
+will always ship empty (or with only comments). We suggest that you
+put all your local changes there, rather than editing <code>ficl.h</code>
+or editing the makefile. That should make it much easier to integrate
+future Ficl releases into your product—all you need do is preserve
+your tweaked copy of <code>ficllocal.h</code> and replace the rest.
+
+
+<? ficlHeader2("Renamed Functions") ?>+
+Every function that deals primarily with a particular structure
+is now named after that structure. For instance, any function
+that takes a <code>ficlSystem</code> as its first argument is
+named <code>ficlSystem<i>Something</i>()</code>. Any function
+that takes a <code>ficlVm</code> as its first argument is
+named <code>ficlVm<i>Something</i>()</code>. And so on.
+<p>
+
+Also, functions that create a new object are always
+called <code>Create</code> (not <code>Alloc</code>, <code>Allot</code>, <code>Init</code>, or <code>New</code>).
+Functions that create a new object are always
+called <code>Destroy</code> (not <code>Free</code>, <code>Term</code>, or <code>Delete</code>).
+<p>
+
+
+<?
+
+startoldvsnew()
+
+oldvsnew("ficlInitSystem()", "ficlSystemCreate()")+oldvsnew("ficlTermSystem()", "ficlSystemDestroy()")+oldvsnew("ficlNewVM()", "ficlSystemCreateVm()")+oldvsnew("ficlFreeVM()", "ficlVmDestroy()")+oldvsnew("dictCreate()", "ficlDictionaryCreate()")+oldvsnew("dictDelete()", "ficlDictionaryDestroy()")+
+endoldvsnew()
+
+?>
+<p>
+
+All functions exported by Ficl now start with the word <code>ficl</code>.
+This is a <i>feature</i>, as it means the Ficl project will no longer
+pollute your namespace.
+
+<?
+
+startoldvsnew()
+
+oldvsnew("PUSHPTR(p)", "ficlStackPushPointer(vm->dataStack, p)")+oldvsnew("POPUNS()", "ficlStackPopUnsigned(vm->dataStack)")+oldvsnew("GETTOP()", "ficlStackGetTop(vm->dataStack)")+oldvsnew("ltoa()", "ficlLtoa()")+oldvsnew("strincmp()", "ficlStrincomp()")+
+endoldvsnew()
+
+?>
+
+
+
+<? ficlHeader2("Removed Functions") ?>+
+A few entry points have simply been removed.
+For instance, functions specifically managing a system's <code>ENVIRONMENT</code>
+settings have been removed, in favor of managing the system's
+<code>environment</code> dictionary directly:
+<?
+
+startoldvsnew()
+
+oldvsnew("ficlSystemSetEnvironment(system)", "ficlDictionarySetConstant(ficlSystemGetEnvironment(system), ...)")+oldvsnew("ficlSystemSet2Environment(system)", "ficlDictionarySet2Constant(ficlSystemGetEnvironment(system), ...)")+
+endoldvsnew()
+
+?>
+
+
+In a similar vein, <code>ficlSystemBuild()</code> has been removed in favor
+of using <code>ficlDictionarySetPrimitive()</code> directly:
+
+<?
+startoldvsnew()
+oldvsnew("ficlSystemBuild(system, ...)", "ficlDictionarySetPrimitive(ficlSystemGetDictionary(system), ...)")+endoldvsnew()
+?>
+
+Finally, there is no <i>exact</i> replacement for <code>ficlExec()</code>. 99% of the code
+that called <code>ficlExec()</code> never bothered to manage <code>SOURCE-ID</code> properly.
+If you were calling <code>ficlExec()</code>, and you weren't changing <code>SOURCE-ID</code>
+(or <code>vm->sourceId</code>) to match, you should replace those calls with <code>ficlVmEvaluate()</code>,
+which will manage <code>SOURCE-ID</code> for you.
+<p>
+
+There <i>is</i> a function that takes the place of <code>ficlExec()</code> which doesn't change
+<code>SOURCE-ID</code>: <code>ficlVmExecuteString()</code>. However, instead of taking a
+straight C string (a <code>char *</code>), it takes a <code>ficlString *</code> as its
+code argument. (This is to discourage its use.)
+
+
+<?
+ficlHeader1("Internal Changes")+?>
+
+<b>Note:</b> none of these changes should affect you. If they do, there's probably
+a problem somewhere. Either Ficl's API doesn't abstract away something enough, or
+you are approaching a problem the wrong way. Food for thought.
+<p>
+
+There's only one internal change worth noting here.
+The top value on a Ficl stack used to be at (to use the modern structure names)
+<code>stack->top[-1]</code>. It is now at <code>stack->top[0]</code>.
+In other words, the "stack top" pointer used to point <i>past</i> the top
+element; it now points <i>at</i> the top element. (Pointing <i>at</i> the
+top element is not only less confusing, it is also faster.)
+
+</body>
+</html>
--- /dev/null
+++ b/doc/upgrading.html
@@ -1,0 +1,808 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name='Description' content='Ficl - embedded scripting with object oriented programming'>
+<META name='Keywords' content='scripting prototyping tcl OOP Forth interpreter C'>
+<LINK rel='SHORTCUT ICON' href='ficl.ico'>
+<TITLE>upgrading ficl</TITLE>
+<style>
+
+blockquote { margin-left: 1em }+
+</style>
+
+</HEAD>
+<BODY>
+
+<table border=0 cellspacing=0 width=100%%><tr>
+
+
+<td width=112 bgcolor=#004968 colspan=3>
+<img src=graphics/ficl.4.96.jpg height=96 width=96>
+</td>
+
+<td bgcolor=#004968>
+<font face=arial,helvetica color=white size=7><b><i>
+upgrading ficl
+</i></b></font>
+</td></tr>
+
+
+<tr>
+<td bgcolor=#004968 width=10></td>
+<td bgcolor=#004968 valign=top>
+<br><p>
+<a href=index.html><font face=arial,helvetica color=white><b>Index</b></font></a><p>
+<p><br>
+<a href=dpans.html><font face=arial,helvetica color=white><b>ANS</b></font></a><br>
+<a href=api.html><font face=arial,helvetica color=white><b>API</b></font></a><br>
+<a href=debugger.html><font face=arial,helvetica color=white><b>Debugger</b></font></a><br>
+<a href=http://sourceforge.net/project/showfiles.php?group_id=24441><font face=arial,helvetica color=white><b>Download</b></font></a><br>
+<a href=license.html><font face=arial,helvetica color=white><b>Licensing</b></font></a><br>
+<a href=links.html><font face=arial,helvetica color=white><b>Links</b></font></a><br>
+<a href=locals.html><font face=arial,helvetica color=white><b>Locals</b></font></a><br>
+<a href=oop.html><font face=arial,helvetica color=white><b>OOP In Ficl</b></font></a><br>
+<a href=parsesteps.html><font face=arial,helvetica color=white><b>Parse Steps</b></font></a><br>
+<a href=releases.html><font face=arial,helvetica color=white><b>Release History</b></font></a><br>
+<a href=upgrading.html><font face=arial,helvetica color=white><b>Upgrading To 4.0</b></font></a><br>
+</td><td bgcolor=#004968 width=5></td><td valign=top><blockquote><p>
+
+
+
+Ficl 4.0 is smaller, faster, and more capable than any previous
+version. For more information on why Ficl 4.0 is so gosh-darned
+swell, see the <a href=index.html#WhatsNewInFicl4.0>What's New In Ficl 4.0?</a>
+section of the overview.
+<p>
+
+
+Since the Ficl API has changed so dramatically, you can't just drop
+the new Ficl source. You have two basic choices:
+<a href=#compatibility>use the <code>FICL_WANT_COMPATIBILITY</code> support</a>, and
+<a href=#newapi>switching to the new API</a>.
+<p>
+
+Note that using <i>either</i> of these choices <i>requires</i>
+that you recompile your application. You cannot build Ficl 4 into
+a shared library or DLL and use it with an application expecting
+Ficl 3.0. Stated another way: Ficl 4 is <i>source</i> compatible
+but not <i>binary</i> compatible with Ficl 3.
+
+
+<a name=oldnames>
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='UsingcodeFICL_WANT_COMPATIBILITY/code'>
+Using <code>FICL_WANT_COMPATIBILITY</code>
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+</a>
+
+
+If you want to get Ficl 4.0 up and running in your project as quickly
+as possible, <code>FICL_WANT_COMPATIBILITY</code> is what you'll want to use.
+There are two easy steps, one of which you might be able to skip:
+<p>
+
+<ol>
+
+<li>
+Set the C preprocessor constant <code>FICL_WANT_COMPATIBILITY</code> to 1.
+The best way is by adding the following line to <code>ficllocal.h</code>:
+<pre>
+ #define FICL_WANT_COMPATIBILITY (1)
+</pre>
+
+
+<li>
+
+<i>If</i> you use a custom <code>ficlTextOut()</code> function, you'll
+have to rename it, and explicitly specify it to Ficl. Renaming it is
+necessary, because the Ficl compatibility layer also provides one for
+code that called <code>ficlTextOut()</code> directly (instead of calling
+<code>vmTextOut()</code> as it should have).
+We recommend renaming your function to <code>ficlTextOutLocal()</code>, as
+we have have provided a prototype for this function for you in <code>ficlcompatibility.h</code>.
+This will save you the trouble of defining your own prototype, ensuring you get
+correct name decoration / linkage, etc.
+
+<p>
+
+There are two methods you can use to specify your <code>ficlTextOut()</code>
+function:
+<ol>
+
+<li>
+Specify it in the <code>FICL_INIT_INFO</code> structure passed in to
+<code>ficlInitSystem()</code>. This is the preferred method, as it ensures
+you will see the results of Ficl's initialization code, and it will be
+automatically passed in to every newly created VM.
+
+<li>
+Set it explicitly in every VM by calling <code>vmSetTextOut()</code> and
+passing it in.
+
+</ol>
+<p>
+
+<b>Note:</b> Any other method, such as setting it by hand in the
+<code>FICL_SYSTEM</code> or <code>FICL_VM</code> structures,
+will <b>not</b> work. There is a special compatibility layer for old-style
+<code>OUTFUNC</code> functions, but it is only invoked properly when you
+use one of the two methods mentioned above.
+
+
+</ol>
+
+<p>
+
+This <i>should</i> be sufficient for you to recompile-and-go
+with Ficl 4. If it's not, please let us know, preferably including a
+suggested solution to the problem.
+
+
+<a name=newapi>
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='UsingTheNewAPI'>
+Using The New API
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+</a>
+
+Since most (all?) of the external symbols have changed names since the 3.0 series,
+here is a quick guide to get you started on renaming everything. This is by no
+means an exhaustive list; this is meant to guide you towards figuring out what
+the new name <i>should</i> be. (After all, part of the point of this massive
+renaming was to make all the external symbols consistent.)
+<p>
+
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='Types'>
+Types
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+Every external type has been renamed. They all begin with the
+word <code>ficl</code>, and they use mixed case (instead of all upper-case,
+which is now reserved for macros). Also, the confusingly-named
+string objects have been renamed:
+<code>FICL_STRING</code> is now <code>ficlCountedString</code>, as it
+represents a "counted string" in the language, and
+the more commonly-used <code>STRINGINFO</code> is now simply
+<code>ficlString</code>.
+
+<table width=100%><tr>
+
+<td bgcolor=#d0d0f0><b>old name</b></td>
+
+<td bgcolor=#e0e0ff><b>new name</td>
+
+</tr>
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FICL_SYSTEM</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlSystem</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FICL_VM</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlVm</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FICL_SYSTEM_INFO</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlSystemInformation</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FICL_WORD</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlWord</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>IPTYPE</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlIp</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FICL_CODE</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlPrimitive</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>OUTFUNC</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlOutputFunction</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FICL_DICTIONARY</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlDictionary</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FICL_STACK</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlStack</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>STRINGINFO</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlString</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FICL_STRING</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlCountedString</code></td>
+
+</tr>
+
+
+</table><p>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='StructureMembers'>
+Structure Members
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+In addition, many structure names have changed. To help ease the heartache,
+we've also added some accessor macros. So, in case they change in the future,
+your code might still compile (hooray!).
+<table width=100%><tr>
+
+<td bgcolor=#d0d0f0><b>old name</b></td>
+
+<td bgcolor=#e0e0ff><b>new name</td>
+
+<td bgcolor=#d0d0f0><b>accessor</td>
+
+</tr>
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>pExtend</code></td>
+
+<td bgcolor=#f0f0f0><code>context</code></td>
+
+<td bgcolor=#e0e0e0><code>ficlVmGetContext(), ficlSystemGetContext()</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>pStack</code></td>
+
+<td bgcolor=#f0f0f0><code>dataStack</code></td>
+
+<td bgcolor=#e0e0e0><code>ficlVmGetDataStack()</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>fStack</code></td>
+
+<td bgcolor=#f0f0f0><code>floatStack</code></td>
+
+<td bgcolor=#e0e0e0><code>ficlVmGetFloatStack()</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>rStack</code></td>
+
+<td bgcolor=#f0f0f0><code>returnStack</code></td>
+
+<td bgcolor=#e0e0e0><code>ficlVmGetReturnStack()</code></td>
+
+</tr>
+
+
+</table><p>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='CallbackFunctions'>
+Callback Functions
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+Text output callbacks have changed in two major ways:
+
+<ul>
+
+<li>
+They no longer take a VM pointer; they now take a <code>ficlCallback</code> structure.
+This allows output to be printed before a VM is defined, or in circumstances where a
+VM may not be defined (such as an assertion failure in a <code>ficlSystem...()</code> function).
+
+<li>
+They no longer take a flag indicating whether or not to add a "newline".
+Instead, the function must output a newline whenever it encounters
+a <code>\n</code> character in the text.
+
+</ul>
+
+If you don't want to rewrite your output function yet, you can
+"thunk" the new-style call to the old-style. Just pass in <code>ficlOldnamesCallbackTextOut</code>
+as the name of the output function for the system and VM, and then set
+the <code>thunkedTextout</code> member of the <code>ficlSystem</code>
+or <code>ficlVm</code> to your old-style text output function.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='RenamedMacros'>
+Renamed Macros
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<table width=100%><tr>
+
+<td bgcolor=#d0d0f0><b>old name</b></td>
+
+<td bgcolor=#e0e0ff><b>new name</td>
+
+</tr>
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>PUSHPTR(p)</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlStackPushPointer(vm->dataStack, p)</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>POPUNS()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlStackPopUnsigned(vm->dataStack)</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>GETTOP()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlStackGetTop(vm->dataStack)</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FW_IMMEDIATE</code></td>
+
+<td bgcolor=#f0f0f0><code>FICL_WORD_IMMEDIATE</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>FW_COMPILE</code></td>
+
+<td bgcolor=#f0f0f0><code>FICL_WORD_COMPILE_ONLY</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>VM_INNEREXIT</code></td>
+
+<td bgcolor=#f0f0f0><code>FICL_VM_STATUS_INNER_EXIT</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>VM_OUTOFTEXT</code></td>
+
+<td bgcolor=#f0f0f0><code>FICL_VM_STATUS_OUT_OF_TEXT</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>VM_RESTART</code></td>
+
+<td bgcolor=#f0f0f0><code>FICL_VM_RESTART</code></td>
+
+</tr>
+
+
+</table><p>
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='codeficllocalh/code'>
+<code>ficllocal.h</code>
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+One more note about macros. Ficl now ships with a standard place for
+you to tweak the Ficl compile-time preprocessor switches such as
+<code>FICL_WANT_COMPATIBILITY</code> and <code>FICL_WANT_FLOAT</code>.
+It's a file called <code>ficllocal.h</code>, and we guarantee that it
+will always ship empty (or with only comments). We suggest that you
+put all your local changes there, rather than editing <code>ficl.h</code>
+or editing the makefile. That should make it much easier to integrate
+future Ficl releases into your product—all you need do is preserve
+your tweaked copy of <code>ficllocal.h</code> and replace the rest.
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='RenamedFunctions'>
+Renamed Functions
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+Every function that deals primarily with a particular structure
+is now named after that structure. For instance, any function
+that takes a <code>ficlSystem</code> as its first argument is
+named <code>ficlSystem<i>Something</i>()</code>. Any function
+that takes a <code>ficlVm</code> as its first argument is
+named <code>ficlVm<i>Something</i>()</code>. And so on.
+<p>
+
+Also, functions that create a new object are always
+called <code>Create</code> (not <code>Alloc</code>, <code>Allot</code>, <code>Init</code>, or <code>New</code>).
+Functions that create a new object are always
+called <code>Destroy</code> (not <code>Free</code>, <code>Term</code>, or <code>Delete</code>).
+<p>
+
+
+<table width=100%><tr>
+
+<td bgcolor=#d0d0f0><b>old name</b></td>
+
+<td bgcolor=#e0e0ff><b>new name</td>
+
+</tr>
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>ficlInitSystem()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlSystemCreate()</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>ficlTermSystem()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlSystemDestroy()</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>ficlNewVM()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlSystemCreateVm()</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>ficlFreeVM()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlVmDestroy()</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>dictCreate()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlDictionaryCreate()</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>dictDelete()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlDictionaryDestroy()</code></td>
+
+</tr>
+
+
+</table><p>
+
+
+<p>
+
+All functions exported by Ficl now start with the word <code>ficl</code>.
+This is a <i>feature</i>, as it means the Ficl project will no longer
+pollute your namespace.
+
+<table width=100%><tr>
+
+<td bgcolor=#d0d0f0><b>old name</b></td>
+
+<td bgcolor=#e0e0ff><b>new name</td>
+
+</tr>
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>PUSHPTR(p)</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlStackPushPointer(vm->dataStack, p)</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>POPUNS()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlStackPopUnsigned(vm->dataStack)</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>GETTOP()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlStackGetTop(vm->dataStack)</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>ltoa()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlLtoa()</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>strincmp()</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlStrincomp()</code></td>
+
+</tr>
+
+
+</table><p>
+
+
+
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#b8b8b8 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=4><b><i>
+<a name='RemovedFunctions'>
+Removed Functions
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+A few entry points have simply been removed.
+For instance, functions specifically managing a system's <code>ENVIRONMENT</code>
+settings have been removed, in favor of managing the system's
+<code>environment</code> dictionary directly:
+<table width=100%><tr>
+
+<td bgcolor=#d0d0f0><b>old name</b></td>
+
+<td bgcolor=#e0e0ff><b>new name</td>
+
+</tr>
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>ficlSystemSetEnvironment(system)</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlDictionarySetConstant(ficlSystemGetEnvironment(system), ...)</code></td>
+
+</tr>
+
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>ficlSystemSet2Environment(system)</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlDictionarySet2Constant(ficlSystemGetEnvironment(system), ...)</code></td>
+
+</tr>
+
+
+</table><p>
+
+
+
+
+In a similar vein, <code>ficlSystemBuild()</code> has been removed in favor
+of using <code>ficlDictionarySetPrimitive()</code> directly:
+
+<table width=100%><tr>
+
+<td bgcolor=#d0d0f0><b>old name</b></td>
+
+<td bgcolor=#e0e0ff><b>new name</td>
+
+</tr>
+
+<tr>
+
+<td bgcolor=#e0e0e0><code>ficlSystemBuild(system, ...)</code></td>
+
+<td bgcolor=#f0f0f0><code>ficlDictionarySetPrimitive(ficlSystemGetDictionary(system), ...)</code></td>
+
+</tr>
+
+
+</table><p>
+
+
+
+Finally, there is no <i>exact</i> replacement for <code>ficlExec()</code>. 99% of the code
+that called <code>ficlExec()</code> never bothered to manage <code>SOURCE-ID</code> properly.
+If you were calling <code>ficlExec()</code>, and you weren't changing <code>SOURCE-ID</code>
+(or <code>vm->sourceId</code>) to match, you should replace those calls with <code>ficlVmEvaluate()</code>,
+which will manage <code>SOURCE-ID</code> for you.
+<p>
+
+There <i>is</i> a function that takes the place of <code>ficlExec()</code> which doesn't change
+<code>SOURCE-ID</code>: <code>ficlVmExecuteString()</code>. However, instead of taking a
+straight C string (a <code>char *</code>), it takes a <code>ficlString *</code> as its
+code argument. (This is to discourage its use.)
+
+
+
+<p>
+</blockquote><table border=0 bgcolor=#a0a0a0 width=100%><tr>
+
+<td width=1em></td>
+<td>
+<font face=arial,helvetica color=#004968 size=5><b><i>
+<a name='InternalChanges'>
+Internal Changes
+</a></i></b></font></td></tr></table><p><blockquote>
+
+
+
+<b>Note:</b> none of these changes should affect you. If they do, there's probably
+a problem somewhere. Either Ficl's API doesn't abstract away something enough, or
+you are approaching a problem the wrong way. Food for thought.
+<p>
+
+There's only one internal change worth noting here.
+The top value on a Ficl stack used to be at (to use the modern structure names)
+<code>stack->top[-1]</code>. It is now at <code>stack->top[0]</code>.
+In other words, the "stack top" pointer used to point <i>past</i> the top
+element; it now points <i>at</i> the top element. (Pointing <i>at</i> the
+top element is not only less confusing, it is also faster.)
+
+</body>
+</html>
--- /dev/null
+++ b/double.c
@@ -1,0 +1,479 @@
+/*******************************************************************
+** m a t h 6 4 . c
+** Forth Inspired Command Language - 64 bit math support routines
+** Authors: Michael A. Gauland ([email protected])
+** Larry Hastings ([email protected])
+** John Sadler ([email protected])
+** 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.3 2010/11/01 14:10:27 asau Exp $
+*******************************************************************/
+/*
+** Copyright (c) 1997-2001 John Sadler ([email protected])
+** 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 <stdint.h>
+
+#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;
+ int sign = 1;
+
+ if (x < 0)
+ {+ sign = -sign;
+ x = -x;
+ }
+
+ if (y < 0)
+ {+ sign = -sign;
+ y = -y;
+ }
+
+ prod = ficl2UnsignedMultiply(x, y);
+ if (sign > 0)
+ return FICL_2UNSIGNED_TO_2INTEGER(prod);
+ else
+ return ficl2IntegerNegate(FICL_2UNSIGNED_TO_2INTEGER(prod));
+}
+
+
+
+ficl2Integer ficl2IntegerDecrement(ficl2Integer x)
+{+ if (x.low == INT_MIN)
+ x.high--;
+ x.low--;
+
+ return x;
+}
+
+
+ficl2Unsigned ficl2UnsignedAdd(ficl2Unsigned x, ficl2Unsigned y)
+{+ ficl2Unsigned result;
+ int carry;
+
+ result.high = x.high + y.high;
+ result.low = x.low + y.low;
+
+
+ carry = ((x.low | y.low) & FICL_CELL_HIGH_BIT) && !(result.low & FICL_CELL_HIGH_BIT);
+ carry |= ((x.low & y.low) & FICL_CELL_HIGH_BIT);
+
+ if (carry)
+ {+ result.high++;
+ }
+
+ return result;
+}
+
+/**************************************************************************
+ ficl2UnsignedMultiply
+** Contributed by:
+** Michael A. Gauland [email protected]
+**************************************************************************/
+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 [email protected]
+**************************************************************************/
+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 */
+
+
+
+/**************************************************************************
+ ficl2IntegerAbsoluteValue
+** Returns the absolute value of an ficl2Unsigned
+**************************************************************************/
+ficl2Integer ficl2IntegerAbsoluteValue(ficl2Integer x)
+{+ if (ficl2IntegerIsNegative(x))
+ return ficl2IntegerNegate(x);
+ return x;
+}
+
+
+/**************************************************************************
+ 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;
+ int signRem = 1;
+ int signQuot = 1;
+
+ if (ficl2IntegerIsNegative(num))
+ {+ num = ficl2IntegerNegate(num);
+ signQuot = -signQuot;
+ }
+
+ if (den < 0)
+ {+ den = -den;
+ signRem = -signRem;
+ signQuot = -signQuot;
+ }
+
+ uqr = ficl2UnsignedDivide(FICL_2INTEGER_TO_2UNSIGNED(num), (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;
+ int signRem = 1;
+ int signQuot = 1;
+
+ if (ficl2IntegerIsNegative(num))
+ {+ num = ficl2IntegerNegate(num);
+ signRem = -signRem;
+ signQuot = -signQuot;
+ }
+
+ if (den < 0)
+ {+ den = -den;
+ signQuot = -signQuot;
+ }
+
+ uqr = ficl2UnsignedDivide(FICL_2INTEGER_TO_2UNSIGNED(num), (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;
+}
+
+
--- /dev/null
+++ b/extras.c
@@ -1,0 +1,267 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+#include <unistd.h>
+
+#include "ficl.h"
+
+
+#ifndef FICL_ANSI
+
+/*
+** Ficl interface to _getcwd (Win32)
+** Prints the current working directory using the VM's
+** textOut method...
+*/
+static void ficlPrimitiveGetCwd(ficlVm *vm)
+{+ char *directory;
+
+ directory = getcwd(NULL, 80);
+ ficlVmTextOut(vm, directory);
+ ficlVmTextOut(vm, "\n");
+ free(directory);
+ return;
+}
+
+
+
+/*
+** Ficl interface to _chdir (Win32)
+** Gets a newline (or NULL) delimited string from the input
+** and feeds it to the Win32 chdir function...
+** Example:
+** cd c:\tmp
+*/
+static void ficlPrimitiveChDir(ficlVm *vm)
+{+ ficlCountedString *counted = (ficlCountedString *)vm->pad;
+ ficlVmGetString(vm, counted, '\n');
+ if (counted->length > 0)
+ {+ int err = chdir(counted->text);
+ if (err)
+ {+ ficlVmTextOut(vm, "Error: path not found\n");
+ ficlVmThrow(vm, FICL_VM_STATUS_QUIT);
+ }
+ }
+ else
+ {+ ficlVmTextOut(vm, "Warning (chdir): nothing happened\n");
+ }
+ return;
+}
+
+
+
+static void ficlPrimitiveClock(ficlVm *vm)
+{+ clock_t now = clock();
+ ficlStackPushUnsigned(vm->dataStack, (ficlUnsigned)now);
+ return;
+}
+
+#endif /* FICL_ANSI */
+
+
+/*
+** 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");
+ }
+ return;
+}
+
+
+
+/*
+** Ficl add-in to load a text file and execute it...
+** Cheesy, but illustrative.
+** Line oriented... filename is newline (or NULL) delimited.
+** Example:
+** load test.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);
+ return;
+}
+
+
+
+/*
+** 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);
+ return;
+}
+
+static void ficlPrimitiveBreak(ficlVm *vm)
+{+ vm->state = vm->state;
+ return;
+}
+
+
+
+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);
+
+#ifndef FICL_ANSI
+ ficlDictionarySetPrimitive(dictionary, "clock", ficlPrimitiveClock, FICL_WORD_DEFAULT);
+ ficlDictionarySetConstant(dictionary, "clocks/sec", CLOCKS_PER_SEC);
+ ficlDictionarySetPrimitive(dictionary, "pwd", ficlPrimitiveGetCwd, FICL_WORD_DEFAULT);
+ ficlDictionarySetPrimitive(dictionary, "cd", ficlPrimitiveChDir, FICL_WORD_DEFAULT);
+#endif /* FICL_ANSI */
+
+ return;
+}
+
--- /dev/null
+++ b/ficl.dsw
@@ -1,0 +1,59 @@
+Microsoft Developer Studio Workspace File, Format Version 6.00
+# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
+
+###############################################################################
+
+Project: "ficldll"=.\ficldll.dsp - Package Owner=<4>
+
+Package=<5>
+{{{+}}}
+
+Package=<4>
+{{{+ Begin Project Dependency
+ Project_Dep_Name ficllib
+ End Project Dependency
+}}}
+
+###############################################################################
+
+Project: "ficlexe"=.\ficlexe.dsp - Package Owner=<4>
+
+Package=<5>
+{{{+}}}
+
+Package=<4>
+{{{+ Begin Project Dependency
+ Project_Dep_Name ficllib
+ End Project Dependency
+}}}
+
+###############################################################################
+
+Project: "ficllib"=.\ficllib.dsp - Package Owner=<4>
+
+Package=<5>
+{{{+}}}
+
+Package=<4>
+{{{+}}}
+
+###############################################################################
+
+Global:
+
+Package=<5>
+{{{+}}}
+
+Package=<3>
+{{{+}}}
+
+###############################################################################
+
--- /dev/null
+++ b/ficl.h
@@ -1,0 +1,1860 @@
+/*******************************************************************
+** f i c l . h
+** Forth Inspired Command Language
+** Author: John Sadler ([email protected])
+** Created: 19 July 1997
+** Dedicated to RHS, in loving memory
+** $Id: ficl.h,v 1.31 2010/12/22 10:24:03 asau Exp $
+********************************************************************
+**
+** Copyright (c) 1997-2001 John Sadler ([email protected])
+** 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.
+*/
+
+#if !defined (__FICL_H__)
+#define __FICL_H__
+/*
+** Ficl (Forth-inspired command language) is an ANS Forth
+** interpreter written in C. Unlike traditional Forths, this
+** interpreter is designed to be embedded into other systems
+** as a command/macro/development prototype language.
+**
+** Where Forths usually view themselves as the center of the system
+** and expect the rest of the system to be coded in Forth, Ficl
+** acts as a component of the system. It is easy to export
+** code written in C or ASM to Ficl in the style of TCL, or to invoke
+** Ficl code from a compiled module. This allows you to do incremental
+** development in a way that combines the best features of threaded
+** languages (rapid development, quick code/test/debug cycle,
+** reasonably fast) with the best features of C (everyone knows it,
+** easier to support large blocks of code, efficient, type checking).
+**
+** Ficl provides facilities for interoperating
+** with programs written in C: C functions can be exported to Ficl,
+** and Ficl commands can be executed via a C calling interface. The
+** interpreter is re-entrant, so it can be used in multiple instances
+** in a multitasking system. Unlike Forth, Ficl's outer interpreter
+** expects a text block as input, and returns to the caller after each
+** text block, so the "data pump" is somewhere in external code. This
+** is more like TCL than Forth, which usually 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
+
+#include <limits.h>
+#include <setjmp.h>
+#include <stdarg.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.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"
+
+
+
+
+#if defined(FICL_ANSI)
+ #include "ficlplatform/ansi.h"
+#elif defined(_WIN32)
+ #include "ficlplatform/win32.h"
+#elif defined(unix) || defined(__unix__) || defined(__unix)
+ #include "ficlplatform/unix.h"
+#else /* catch-all */
+ #include "ficlplatform/ansi.h"
+#endif /* platform */
+
+
+
+/*
+**
+** 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 (0)
+#endif /* FICL_WANT_PLATFORM */
+
+
+/*
+** FICL_WANT_COMPATIBILITY
+** Changes Ficl 4 at compile-time so it is source-compatible
+** with the Ficl 3 API. If you are a new user to Ficl you
+** don't need to worry about this setting; if you are upgrading
+** from a pre-4.0 version of Ficl, see doc/upgrading.html for
+** more information.
+*/
+#if !defined FICL_WANT_COMPATIBILITY
+#define FICL_WANT_COMPATIBILITY (0)
+#endif /* !defined FICL_WANT_COMPATIBILITY */
+
+
+
+/*
+** FICL_WANT_LZ_SOFTCORE
+** If nonzero, the softcore words are stored compressed
+** with patent-unencumbered Lempel-Ziv '77 compression.
+** This results in a smaller Ficl interpreter, and adds
+** only a *tiny* runtime speed hit.
+**
+** As of version 4.0.27, all the runtime code for the decompressor
+** is 688 bytes on a single-threaded release build, but saves 14179
+** bytes of data. That's a net savings of over 13k! Plus, it makes
+** the resulting executable harder to hack :)
+**
+** On my 850MHz Duron machine, decompression took 0.00384 seconds
+** if QueryPerformanceCounter() can be believed... it claims that it
+** took 13765 cycles to complete, and that my machine runs 3579545
+** cycles/second.
+**
+** Contributed by Larry Hastings.
+*/
+#if !defined (FICL_WANT_LZ_SOFTCORE)
+#define FICL_WANT_LZ_SOFTCORE (1)
+#endif /* FICL_WANT_LZ_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 (1)
+#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 (0)
+#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 static
+#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"
+
+#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
+
+
+/*
+** Jiggery-pokery for the FICL_WANT_COMPATIBILITY compatibility layer.
+** Even if you're not using it, compatibility.c won't compile properly
+** unless FICL_WANT_COMPATIBILITY is turned on. Hence, we force it to
+** always be turned on.
+*/
+#ifdef FICL_FORCE_COMPATIBILITY
+#undef FICL_WANT_COMPATIBILITY
+#define FICL_WANT_COMPATIBILITY (1)
+#endif /* FICL_FORCE_COMPATIBILITY */
+
+
+
+
+
+/*
+** 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_2INTEGER_TO_2UNSIGNED(doublei) ((ficl2Unsigned)(doublei))
+
+#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_2UNSIGNED_TO_2INTEGER(doubleu) ((ficl2Integer)(doubleu))
+
+#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_2INTEGER_TO_2UNSIGNED(doublei) (*(ficl2Unsigned *)(&(doublei)))
+
+
+#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_2UNSIGNED_TO_2INTEGER(doubleu) (*(ficl2Integer *)(&(doubleu)))
+
+#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 */
+
+FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerAbsoluteValue(ficl2Integer x);
+
+/*
+** These structures represent the result of division.
+*/
+typedef struct
+{+ ficl2Unsigned quotient;
+ ficlUnsigned remainder;
+} ficl2UnsignedQR;
+
+typedef struct
+{+ ficl2Integer quotient;
+ ficlInteger remainder;
+} 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);
+} 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
+
+
+/*
+** FICL_LVALUE_TO_CELL does a little pointer trickery to cast any CELL sized
+** lvalue (informal definition: an expression whose result has an
+** address) to CELL. Remember that constants and casts are NOT
+** themselves lvalues!
+*/
+#define FICL_LVALUE_TO_CELL(v) (*(ficlCell *)&v)
+
+/*
+** 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; /* 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 ficlInteger 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 */
+ ficlWord *runningWord;/* address of currently running word (often just *(ip-1) ) */
+ 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) */
+#if FICL_WANT_COMPATIBILITY
+ ficlCompatibilityOutputFunction thunkedTextout;
+#endif /* FICL_WANT_COMPATIBILITY */
+};
+
+
+/*
+** 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
+*/
+#define FICL_VM_STATUS_INNER_EXIT (-256) /* tell ficlVmExecuteXT to exit inner loop */
+#define FICL_VM_STATUS_OUT_OF_TEXT (-257) /* hungry - normal exit */
+#define FICL_VM_STATUS_RESTART (-258) /* word needs more text to succeed -- re-run it */
+#define FICL_VM_STATUS_USER_EXIT (-259) /* user wants to quit */
+#define FICL_VM_STATUS_ERROR_EXIT (-260) /* interpreter found an error */
+#define FICL_VM_STATUS_BREAK (-261) /* debugger breakpoint */
+#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 -- abort" */
+#define FICL_VM_STATUS_QUIT ( -56) /* like FICL_VM_STATUS_ERROR_EXIT, but leave dataStack & base alone */
+
+
+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)->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 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;
+ ficlUnsigned8 flags; /* Immediate, Smudge, Compile-only, IsOjbect, Instruction */
+ 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, float value);
+FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppendF2Constant(ficlDictionary *dictionary, char *name, double 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, float value);
+FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySetF2Constant(ficlDictionary *dictionary, char *name, double 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 */
+ void *context; /* Initializes VM's context pointer - for application use */
+ 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;
+
+ ficlInstruction 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;
+#if FICL_WANT_COMPATIBILITY
+ ficlCompatibilityOutputFunction thunkedTextout;
+#endif /* FICL_WANT_COMPATIBILITY */
+};
+
+
+#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);
+
+
+
+
+/*
+** 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);
+
+
+/*
+** Used with compressed softcore.
+**
+*/
+
+#ifndef FICL_BIT_NUMBER
+#define FICL_BIT_NUMBER(x) (1 << (x))
+#endif /* FICL_BIT_NUMBER */
+
+#ifndef FICL_BIT_SET
+#define FICL_BIT_SET(value, flag) ((value) |= (flag))
+#endif /* FICL_BIT_SET */
+
+#ifndef FICL_BIT_CLEAR
+#define FICL_BIT_CLEAR(value, flag) ((value) &= ~(flag))
+#endif /* FICL_BIT_CLEAR */
+
+#ifndef FICL_BIT_CHECK
+#define FICL_BIT_CHECK(value, flag) ((value) & (flag))
+#endif /* FICL_BIT_CHECK */
+
+
+#define FICL_LZ_TYPE_BITS (1)
+#define FICL_LZ_OFFSET_BITS (12)
+#define FICL_LZ_LENGTH_BITS (5)
+#define FICL_LZ_NEXT_BITS (8)
+#define FICL_LZ_PHRASE_BITS (FICL_LZ_TYPE_BITS + FICL_LZ_OFFSET_BITS + FICL_LZ_LENGTH_BITS + FICL_LZ_NEXT_BITS)
+#define FICL_LZ_SYMBOL_BITS (FICL_LZ_TYPE_BITS + FICL_LZ_NEXT_BITS)
+
+/*
+** if you match fewer characters than this, don't bother,
+** it's smaller to encode it as a sequence of symbol tokens.
+**/
+#define FICL_LZ_MINIMUM_USEFUL_MATCH ((int)(FICL_LZ_PHRASE_BITS / FICL_LZ_SYMBOL_BITS))
+
+#define FICL_LZ_WINDOW_SIZE (FICL_BIT_NUMBER(FICL_LZ_OFFSET_BITS))
+#define FICL_LZ_BUFFER_SIZE (FICL_BIT_NUMBER(FICL_LZ_LENGTH_BITS) + FICL_LZ_MINIMUM_USEFUL_MATCH)
+
+FICL_PLATFORM_EXTERN int ficlBitGet(const unsigned char *bits, size_t index);
+FICL_PLATFORM_EXTERN void ficlBitSet(unsigned char *bits, size_t size_t, int value);
+FICL_PLATFORM_EXTERN void ficlBitGetString(unsigned char *destination, const unsigned char *source, int offset, int count, int destAlignment);
+
+FICL_PLATFORM_EXTERN ficlUnsigned16 ficlNetworkUnsigned16(ficlUnsigned16 number);
+FICL_PLATFORM_EXTERN ficlUnsigned32 ficlNetworkUnsigned32(ficlUnsigned32 number);
+
+#define FICL_MIN(a, b) (((a) < (b)) ? (a) : (b))
+FICL_PLATFORM_EXTERN int ficlLzCompress(const char *uncompressed, size_t uncompressedSize, unsigned char **compressed, size_t *compressedSize);
+FICL_PLATFORM_EXTERN int ficlLzUncompress(const unsigned char *compressed, char **uncompressed, size_t *uncompressedSize);
+
+
+
+#if FICL_WANT_COMPATIBILITY
+ #include "ficlcompatibility.h"
+#endif /* FICL_WANT_COMPATIBILITY */
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* __FICL_H__ */
--- /dev/null
+++ b/ficlcompatibility.h
@@ -1,0 +1,463 @@
+#ifndef FICL_FORCE_COMPATIBILITY
+
+struct ficl_word;
+typedef struct ficl_word FICL_WORD;
+struct vm;
+typedef struct vm FICL_VM;
+struct ficl_dict;
+typedef struct ficl_dict FICL_DICT;
+struct ficl_system;
+typedef struct ficl_system FICL_SYSTEM;
+struct ficl_system_info;
+typedef struct ficl_system_info FICL_SYSTEM_INFO;
+#define ficlFILE ficlFile
+
+typedef ficlUnsigned FICL_UNS;
+typedef ficlInteger FICL_INT;
+typedef ficlFloat FICL_FLOAT;
+typedef ficlUnsigned16 UNS16;
+typedef ficlUnsigned8 UNS8;
+
+#define _cell ficlCell
+#define CELL ficlCell
+
+#define LVALUEtoCELL(v) (*(ficlCell *)&v)
+#define PTRtoCELL (ficlCell *)(void *)
+#define PTRtoSTRING (ficlCountedString *)(void *)
+
+typedef unsigned char FICL_COUNT;
+#define FICL_STRING_MAX UCHAR_MAX
+typedef struct _ficl_string
+{+ ficlUnsigned8 count;
+ char text[1];
+} FICL_STRING;
+
+typedef struct
+{+ ficlUnsigned count;
+ char *cp;
+} STRINGINFO;
+
+#define SI_COUNT(si) (si.count)
+#define SI_PTR(si) (si.cp)
+#define SI_SETLEN(si, len) (si.count = (FICL_UNS)(len))
+#define SI_SETPTR(si, ptr) (si.cp = (char *)(ptr))
+#define SI_PSZ(si, psz) \
+ {si.cp = psz; si.count = (FICL_COUNT)strlen(psz);}+#define SI_PFS(si, pfs) \
+ {si.cp = pfs->text; si.count = pfs->count;}+
+typedef struct
+{+ ficlInteger index;
+ char *end;
+ char *cp;
+} TIB;
+
+
+typedef struct _ficlStack
+{+ ficlUnsigned nCells; /* size of the stack */
+ CELL *pFrame; /* link reg for stack frame */
+ CELL *sp; /* stack pointer */
+ ficlVm *vm;
+ char *name;
+ CELL base[1]; /* Top of stack */
+} FICL_STACK;
+
+FICL_STACK *stackCreate (unsigned nCells);
+void stackDelete (FICL_STACK *pStack);
+int stackDepth (FICL_STACK *pStack);
+void stackDrop (FICL_STACK *pStack, int n);
+CELL stackFetch (FICL_STACK *pStack, int n);
+CELL stackGetTop (FICL_STACK *pStack);
+void stackLink (FICL_STACK *pStack, int nCells);
+void stackPick (FICL_STACK *pStack, int n);
+CELL stackPop (FICL_STACK *pStack);
+void *stackPopPtr (FICL_STACK *pStack);
+FICL_UNS stackPopUNS (FICL_STACK *pStack);
+FICL_INT stackPopINT (FICL_STACK *pStack);
+void stackPush (FICL_STACK *pStack, CELL c);
+void stackPushPtr (FICL_STACK *pStack, void *ptr);
+void stackPushUNS (FICL_STACK *pStack, FICL_UNS u);
+void stackPushINT (FICL_STACK *pStack, FICL_INT i);
+void stackReset (FICL_STACK *pStack);
+void stackRoll (FICL_STACK *pStack, int n);
+void stackSetTop (FICL_STACK *pStack, CELL c);
+void stackStore (FICL_STACK *pStack, int n, CELL c);
+void stackUnlink (FICL_STACK *pStack);
+
+#if (FICL_WANT_FLOAT)
+float stackPopFloat (FICL_STACK *pStack);
+void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f);
+#endif
+
+#define PUSHPTR(p) stackPushPtr(pVM->pStack,p)
+#define PUSHUNS(u) stackPushUNS(pVM->pStack,u)
+#define PUSHINT(i) stackPushINT(pVM->pStack,i)
+#define PUSHFLOAT(f) stackPushFloat(pVM->fStack,f)
+#define PUSH(c) stackPush(pVM->pStack,c)
+#define POPPTR() stackPopPtr(pVM->pStack)
+#define POPUNS() stackPopUNS(pVM->pStack)
+#define POPINT() stackPopINT(pVM->pStack)
+#define POPFLOAT() stackPopFloat(pVM->fStack)
+#define POP() stackPop(pVM->pStack)
+#define GETTOP() stackGetTop(pVM->pStack)
+#define SETTOP(c) stackSetTop(pVM->pStack,LVALUEtoCELL(c))
+#define GETTOPF() stackGetTop(pVM->fStack)
+#define SETTOPF(c) stackSetTop(pVM->fStack,LVALUEtoCELL(c))
+#define STORE(n,c) stackStore(pVM->pStack,n,LVALUEtoCELL(c))
+#define DEPTH() stackDepth(pVM->pStack)
+#define DROP(n) stackDrop(pVM->pStack,n)
+#define DROPF(n) stackDrop(pVM->fStack,n)
+#define FETCH(n) stackFetch(pVM->pStack,n)
+#define PICK(n) stackPick(pVM->pStack,n)
+#define PICKF(n) stackPick(pVM->fStack,n)
+#define ROLL(n) stackRoll(pVM->pStack,n)
+#define ROLLF(n) stackRoll(pVM->fStack,n)
+
+typedef FICL_WORD ** IPTYPE; /* the VM's instruction pointer */
+typedef void (*OUTFUNC)(FICL_VM *pVM, char *text, int fNewline);
+
+/* values of STATE */
+#define INTERPRET FICL_STATE_INTERPRET
+#define COMPILE FICL_STATE_COMPILE
+
+#if !defined nPAD
+#define nPAD FICL_PAD_SIZE
+#endif
+
+#if !defined nFICLNAME
+#define nFICLNAME FICL_NAME_LENGTH
+#endif
+
+#define FICL_DEFAULT_STACK FICL_DEFAULT_STACK_SIZE
+#define FICL_DEFAULT_DICT FICL_DEFAULT_DICTIONARY_SIZE
+#define FICL_DEFAULT_ENV FICL_DEFAULT_ENVIRONMENT_SIZE
+#define FICL_DEFAULT_VOCS FICL_MAX_WORDLISTS
+
+
+
+
+
+struct vm
+{+ void *pExtend;
+ ficlOutputFunction textOut;
+ ficlOutputFunction errorOut;
+ ficlSystem *pSys;
+ ficlVm *pVM;
+ FICL_VM *link; /* Ficl keeps a VM list for simple teardown */
+ jmp_buf *pState; /* crude exception mechanism... */
+ short fRestart; /* Set TRUE to restart runningWord */
+ IPTYPE ip; /* instruction pointer */
+ FICL_WORD *runningWord;/* address of currently running word (often just *(ip-1) ) */
+ FICL_UNS state; /* compiling or interpreting */
+ FICL_UNS base; /* number conversion base */
+ FICL_STACK *pStack; /* param stack */
+ FICL_STACK *rStack; /* return stack */
+#if FICL_WANT_FLOAT
+ FICL_STACK *fStack; /* float stack (optional) */
+#endif
+ CELL sourceID; /* -1 if EVALUATE, 0 if normal input */
+ TIB tib; /* address of incoming text string */
+#if FICL_WANT_USER
+ CELL user[FICL_USER_CELLS];
+#endif
+ char pad[nPAD]; /* the scratch area (see above) */
+};
+
+/*
+** A FICL_CODE points to a function that gets called to help execute
+** a word in the dictionary. It always gets passed a pointer to the
+** running virtual machine, and from there it can get the address
+** of the parameter area of the word it's supposed to operate on.
+** For precompiled words, the code is all there is. For user defined
+** words, the code assumes that the word's parameter area is a list
+** of pointers to the code fields of other words to execute, and
+** may also contain inline data. The first parameter is always
+** a pointer to a code field.
+*/
+typedef void (*FICL_CODE)(FICL_VM *pVm);
+
+#if 0
+#define VM_ASSERT(pVM) assert((*(pVM->ip - 1)) == pVM->runningWord)
+#else
+#define VM_ASSERT(pVM)
+#endif
+
+#define nName length
+#define ficl_word ficlWord
+#define FICL_WORD ficlWord
+
+#define CELLS_PER_WORD \
+ ( (sizeof (FICL_WORD) + nFICLNAME + sizeof (CELL)) \
+ / (sizeof (CELL)) )
+
+int wordIsImmediate(FICL_WORD *pFW);
+int wordIsCompileOnly(FICL_WORD *pFW);
+
+#define FW_IMMEDIATE FICL_WORD_IMMEDIATE
+#define FW_COMPILE FICL_WORD_COMPILE_ONLY
+#define FW_SMUDGE FICL_WORD_SMUDGED
+#define FW_ISOBJECT FICL_WORD_OBJECT
+
+#define FW_COMPIMMED (FW_IMMEDIATE | FW_COMPILE_ONLY)
+#define FW_DEFAULT 0
+
+
+/*
+** Exit codes for vmThrow
+*/
+#define VM_INNEREXIT FICL_VM_STATUS_INNER_EXIT
+#define VM_OUTOFTEXT FICL_VM_STATUS_OUT_OF_TEXT
+#define VM_RESTART FICL_VM_STATUS_RESTART
+#define VM_USEREXIT FICL_VM_STATUS_USER_EXIT
+#define VM_ERREXIT FICL_VM_STATUS_ERROR_EXIT
+#define VM_BREAK FICL_VM_STATUS_BREAK
+#define VM_ABORT FICL_VM_STATUS_ABORT
+#define VM_ABORTQ FICL_VM_STATUS_ABORTQ
+#define VM_QUIT FICL_VM_STATUS_QUIT
+
+
+void vmBranchRelative(FICL_VM *pVM, int offset);
+FICL_VM * vmCreate (FICL_VM *pVM, unsigned nPStack, unsigned nRStack);
+void vmDelete (FICL_VM *pVM);
+void vmExecute (FICL_VM *pVM, FICL_WORD *pWord);
+FICL_DICT *vmGetDict (FICL_VM *pVM);
+char * vmGetString (FICL_VM *pVM, FICL_STRING *spDest, char delimiter);
+STRINGINFO vmGetWord (FICL_VM *pVM);
+STRINGINFO vmGetWord0 (FICL_VM *pVM);
+int vmGetWordToPad (FICL_VM *pVM);
+STRINGINFO vmParseString (FICL_VM *pVM, char delimiter);
+STRINGINFO vmParseStringEx(FICL_VM *pVM, char delimiter, char fSkipLeading);
+CELL vmPop (FICL_VM *pVM);
+void vmPush (FICL_VM *pVM, CELL c);
+void vmPopIP (FICL_VM *pVM);
+void vmPushIP (FICL_VM *pVM, IPTYPE newIP);
+void vmQuit (FICL_VM *pVM);
+void vmReset (FICL_VM *pVM);
+void vmSetTextOut (FICL_VM *pVM, OUTFUNC textOut);
+void vmTextOut (FICL_VM *pVM, char *text, int fNewline);
+void vmThrow (FICL_VM *pVM, int except);
+void vmThrowErr (FICL_VM *pVM, char *fmt, ...);
+
+#define vmGetRunningWord(pVM) ((pVM)->runningWord)
+
+
+#define M_VM_STEP(pVM) \
+ FICL_WORD *tempFW = *(pVM)->ip++; \
+ ficlVmInnerLoop((ficlVm *)pVM, (ficlWord *)tempFW); \
+
+#define M_INNER_LOOP(pVM) \
+ ficlVmInnerLoop((ficlVm *)pVm);
+
+
+void vmCheckStack(FICL_VM *pVM, int popCells, int pushCells);
+#if FICL_WANT_FLOAT
+void vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells);
+#endif
+
+void vmPushTib (FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib);
+void vmPopTib (FICL_VM *pVM, TIB *pTib);
+#define vmGetInBuf(pVM) ((pVM)->tib.cp + (pVM)->tib.index)
+#define vmGetInBufLen(pVM) ((pVM)->tib.end - (pVM)->tib.cp)
+#define vmGetInBufEnd(pVM) ((pVM)->tib.end)
+#define vmGetTibIndex(pVM) (pVM)->tib.index
+#define vmSetTibIndex(pVM, i) (pVM)->tib.index = i
+#define vmUpdateTib(pVM, str) (pVM)->tib.index = (str) - (pVM)->tib.cp
+
+#if defined(_WIN32)
+/* #SHEESH
+** Why do Microsoft Meatballs insist on contaminating
+** my namespace with their string functions???
+*/
+#pragma warning(disable: 4273)
+#endif
+
+int isPowerOfTwo(FICL_UNS u);
+
+char *ltoa( FICL_INT value, char *string, int radix );
+char *ultoa(FICL_UNS value, char *string, int radix );
+char digit_to_char(int value);
+char *strrev( char *string );
+char *skipSpace(char *cp, char *end);
+char *caseFold(char *cp);
+int strincmp(char *cp1, char *cp2, FICL_UNS count);
+
+#if defined(_WIN32)
+#pragma warning(default: 4273)
+#endif
+
+#if !defined HASHSIZE /* Default size of hash table. For most uniform */
+#define HASHSIZE FICL_HASHSIZE /* performance, use a prime number! */
+#endif
+
+#define ficl_hash ficlHash
+#define FICL_HASH ficlHash
+
+void hashForget (FICL_HASH *pHash, void *where);
+UNS16 hashHashCode (STRINGINFO si);
+void hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW);
+FICL_WORD *hashLookup (FICL_HASH *pHash, STRINGINFO si, UNS16 hashCode);
+void hashReset (FICL_HASH *pHash);
+
+struct ficl_dict
+{+ CELL *here;
+ void *context;
+ FICL_WORD *smudge;
+ FICL_HASH *pForthWords;
+ FICL_HASH *pCompile;
+ FICL_HASH *pSearch[FICL_DEFAULT_VOCS];
+ int nLists;
+ unsigned size; /* Number of cells in dict (total)*/
+ ficlSystem *system;
+ CELL dict[1]; /* Base of dictionary memory */
+};
+
+void *alignPtr(void *ptr);
+void dictAbortDefinition(FICL_DICT *pDict);
+void dictAlign (FICL_DICT *pDict);
+int dictAllot (FICL_DICT *pDict, int n);
+int dictAllotCells (FICL_DICT *pDict, int nCells);
+void dictAppendCell (FICL_DICT *pDict, CELL c);
+void dictAppendChar (FICL_DICT *pDict, char c);
+FICL_WORD *dictAppendWord (FICL_DICT *pDict,
+ char *name,
+ FICL_CODE pCode,
+ UNS8 flags);
+FICL_WORD *dictAppendWord2(FICL_DICT *pDict,
+ STRINGINFO si,
+ FICL_CODE pCode,
+ UNS8 flags);
+void dictAppendUNS (FICL_DICT *pDict, FICL_UNS u);
+int dictCellsAvail (FICL_DICT *pDict);
+int dictCellsUsed (FICL_DICT *pDict);
+void dictCheck (FICL_DICT *pDict, FICL_VM *pVM, int n);
+FICL_DICT *dictCreate(unsigned nCELLS);
+FICL_DICT *dictCreateHashed(unsigned nCells, unsigned nHash);
+FICL_HASH *dictCreateWordlist(FICL_DICT *dp, int nBuckets);
+void dictDelete (FICL_DICT *pDict);
+void dictEmpty (FICL_DICT *pDict, unsigned nHash);
+#if FICL_WANT_FLOAT
+void dictHashSummary(FICL_VM *pVM);
+#endif
+int dictIncludes (FICL_DICT *pDict, void *p);
+FICL_WORD *dictLookup (FICL_DICT *pDict, STRINGINFO si);
+#if FICL_WANT_LOCALS
+FICL_WORD *ficlLookupLoc (FICL_SYSTEM *pSys, STRINGINFO si);
+#endif
+void dictResetSearchOrder(FICL_DICT *pDict);
+void dictSetFlags (FICL_DICT *pDict, UNS8 set, UNS8 clr);
+void dictSetImmediate(FICL_DICT *pDict);
+void dictUnsmudge (FICL_DICT *pDict);
+CELL *dictWhere (FICL_DICT *pDict);
+
+typedef int (*FICL_PARSE_STEP)(FICL_VM *pVM, STRINGINFO si);
+
+int ficlAddParseStep(FICL_SYSTEM *pSys, FICL_WORD *pFW); /* ficl.c */
+void ficlAddPrecompiledParseStep(FICL_SYSTEM *pSys, char *name, FICL_PARSE_STEP pStep);
+void ficlListParseSteps(FICL_VM *pVM);
+
+typedef struct FICL_BREAKPOINT
+{+ void *address;
+ FICL_WORD *origXT;
+} FICL_BREAKPOINT;
+
+
+struct ficl_system
+{+ void *pExtend;
+ ficlOutputFunction textOut;
+ ficlOutputFunction errorTextOut;
+ ficlSystem *pSys;
+ ficlVm *vm;
+ FICL_SYSTEM *link;
+ FICL_VM *vmList;
+ FICL_DICT *dp;
+ FICL_DICT *envp;
+ FICL_WORD *pInterp[3];
+ FICL_WORD *parseList[FICL_MAX_PARSE_STEPS];
+
+ FICL_WORD *pExitInner;
+ FICL_WORD *pInterpret;
+
+#if FICL_WANT_LOCALS
+ FICL_DICT *localp;
+ FICL_INT nLocals;
+ CELL *pMarkLocals;
+#endif
+
+ ficlInteger stackSize;
+
+ FICL_BREAKPOINT bpStep;
+};
+
+struct ficl_system_info
+{+ int size; /* structure size tag for versioning */
+ void *pExtend; /* Initializes VM's pExtend pointer - for application use */
+ int nDictCells; /* Size of system's Dictionary */
+ int stackSize; /* Size of system's Dictionary */
+ OUTFUNC textOut; /* default textOut function */
+ int nEnvCells; /* Size of Environment dictionary */
+};
+
+
+#define ficlInitInfo(x) { memset((x), 0, sizeof(FICL_SYSTEM_INFO)); \+ (x)->size = sizeof(FICL_SYSTEM_INFO); }
+
+FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi);
+FICL_SYSTEM *ficlInitSystem(int nDictCells);
+void ficlTermSystem(FICL_SYSTEM *pSys);
+int ficlEvaluate(FICL_VM *pVM, char *pText);
+int ficlExec (FICL_VM *pVM, char *pText);
+int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT nChars);
+int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord);
+FICL_VM *ficlNewVM(FICL_SYSTEM *pSys);
+void ficlFreeVM(FICL_VM *pVM);
+int ficlSetStackSize(int nStackCells);
+FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name);
+FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys);
+FICL_DICT *ficlGetEnv (FICL_SYSTEM *pSys);
+void ficlSetEnv (FICL_SYSTEM *pSys, char *name, FICL_UNS value);
+void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo);
+#if FICL_WANT_LOCALS
+FICL_DICT *ficlGetLoc (FICL_SYSTEM *pSys);
+#endif
+int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags);
+void ficlCompileCore(FICL_SYSTEM *pSys);
+void ficlCompilePrefix(FICL_SYSTEM *pSys);
+void ficlCompileSearch(FICL_SYSTEM *pSys);
+void ficlCompileSoftCore(FICL_SYSTEM *pSys);
+void ficlCompileTools(FICL_SYSTEM *pSys);
+void ficlCompileFile(FICL_SYSTEM *pSys);
+#if FICL_WANT_FLOAT
+void ficlCompileFloat(FICL_SYSTEM *pSys);
+int ficlParseFloatNumber( FICL_VM *pVM, STRINGINFO si ); /* float.c */
+#endif
+#if FICL_WANT_PLATFORM
+void ficlCompilePlatform(FICL_SYSTEM *pSys);
+#endif
+int ficlParsePrefix(FICL_VM *pVM, STRINGINFO si);
+
+void constantParen(FICL_VM *pVM);
+void twoConstParen(FICL_VM *pVM);
+int ficlParseNumber(FICL_VM *pVM, STRINGINFO si);
+void ficlTick(FICL_VM *pVM);
+void parseStepParen(FICL_VM *pVM);
+
+int isAFiclWord(FICL_DICT *pd, FICL_WORD *pFW);
+
+
+
+/* we define it ourselves, for naughty programs that call it directly. */
+void ficlTextOut (FICL_VM *pVM, char *text, int fNewline);
+/* but you can use this one! */
+void ficlTextOutLocal (FICL_VM *pVM, char *text, int fNewline);
+
+
+#endif /* FICL_FORCE_COMPATIBILITY */
--- /dev/null
+++ b/ficldll.def
@@ -1,0 +1,176 @@
+;;;
+;;; Generated by makedef.py at 2003/05/17 19:58:13
+;;;
+
+EXPORTS
+
+ficl2IntegerAbsoluteValue @1
+ficl2IntegerDivideFloored @2
+ficl2IntegerDivideSymmetric @3
+ficl2UnsignedDivide @4
+ficlAlignPointer @5
+ficlBitGet @6
+ficlBitGetString @7
+ficlBitSet @8
+ficlCallbackAssert @9
+ficlCallbackDefaultTextOut @10
+ficlCallbackTextOut @11
+ficlDictionaryAbortDefinition @12
+ficlDictionaryAlign @13
+ficlDictionaryAllot @14
+ficlDictionaryAllotCells @15
+ficlDictionaryAppend2Constant @16
+ficlDictionaryAppend2ConstantInstruction @17
+ficlDictionaryAppendCell @18
+ficlDictionaryAppendCharacter @19
+ficlDictionaryAppendConstant @20
+ficlDictionaryAppendConstantInstruction @21
+ficlDictionaryAppendData @22
+ficlDictionaryAppendInstruction @23
+ficlDictionaryAppendPrimitive @24
+ficlDictionaryAppendString @25
+ficlDictionaryAppendUnsigned @26
+ficlDictionaryAppendWord @27
+ficlDictionaryCellsAvailable @28
+ficlDictionaryCellsUsed @29
+ficlDictionaryClearFlags @30
+ficlDictionaryCreate @31
+ficlDictionaryCreateHashed @32
+ficlDictionaryCreateWordlist @33
+ficlDictionaryDestroy @34
+ficlDictionaryEmpty @35
+ficlDictionaryFindEnclosingWord @36
+ficlDictionaryIncludes @37
+ficlDictionaryIsAWord @38
+ficlDictionaryLookup @39
+ficlDictionaryResetSearchOrder @40
+ficlDictionarySee @41
+ficlDictionarySet2Constant @42
+ficlDictionarySet2ConstantInstruction @43
+ficlDictionarySetConstant @44
+ficlDictionarySetConstantInstruction @45
+ficlDictionarySetFlags @46
+ficlDictionarySetImmediate @47
+ficlDictionarySetInstruction @48
+ficlDictionarySetPrimitive @49
+ficlDictionaryUnsmudge @50
+ficlDictionaryWhere @51
+ficlDigitToCharacter @52
+ficlFileTruncate @53
+ficlFree @54
+ficlHashCode @55
+ficlHashForget @56
+ficlHashInsertWord @57
+ficlHashLookup @58
+ficlHashReset @59
+ficlIsPowerOfTwo @60
+ficlLocalParen @61
+ficlLocalParenIm @62
+ficlLtoa @63
+ficlLzDecodeHeaderField @64
+ficlLzUncompress @65
+ficlMalloc @66
+ficlPrimitiveHashSummary @67
+ficlPrimitiveLiteralIm @68
+ficlPrimitiveParseStepParen @69
+ficlPrimitiveTick @70
+ficlRealloc @71
+ficlStackCheck @72
+ficlStackCreate @73
+ficlStackDepth @74
+ficlStackDestroy @75
+ficlStackWalk @76
+ficlStackDisplay @77
+ficlStackDrop @78
+ficlStackFetch @79
+ficlStackGetTop @80
+ficlStackLink @81
+ficlStackPick @82
+ficlStackPop @83
+ficlStackPop2Integer @84
+ficlStackPop2Unsigned @85
+ficlStackPopFloat @86
+ficlStackPopInteger @87
+ficlStackPopPointer @88
+ficlStackPopUnsigned @89
+ficlStackPush @90
+ficlStackPush2Integer @91
+ficlStackPush2Unsigned @92
+ficlStackPushFloat @93
+ficlStackPushInteger @94
+ficlStackPushPointer @95
+ficlStackPushUnsigned @96
+ficlStackReset @97
+ficlStackRoll @98
+ficlStackSetTop @99
+ficlStackStore @100
+ficlStackUnlink @101
+ficlStrincmp @102
+ficlStringCaseFold @103
+ficlStringReverse @104
+ficlStringSkipSpace @105
+ficlSystemAddParseStep @106
+ficlSystemAddPrimitiveParseStep @107
+ficlSystemCompileCore @108
+ficlSystemCompileFile @109
+ficlSystemCompileFloat @110
+ficlSystemCompilePlatform @111
+ficlSystemCompilePrefix @112
+ficlSystemCompileSearch @113
+ficlSystemCompileSoftCore @114
+ficlSystemCompileTools @115
+ficlSystemCreate @116
+ficlSystemCreateVm @117
+ficlSystemDestroy @118
+ficlSystemDestroyVm @119
+ficlSystemGetDictionary @120
+ficlSystemGetEnvironment @121
+ficlSystemGetLocals @122
+ficlSystemLookup @123
+ficlSystemLookupLocal @124
+ficlUltoa @125
+ficlVmBranchRelative @126
+ficlVmCreate @127
+ficlVmDestroy @128
+ficlVmDictionaryAllot @129
+ficlVmDictionaryAllotCells @130
+ficlVmDictionaryCheck @131
+ficlVmDictionarySimpleCheck @132
+ficlVmDisplayDataStack @133
+ficlVmDisplayDataStackSimple @134
+ficlVmDisplayFloatStack @135
+ficlVmDisplayReturnStack @136
+ficlVmEvaluate @137
+ficlVmExecuteString @138
+ficlVmExecuteWord @139
+ficlVmExecuteXT @140
+ficlVmGetDictionary @141
+ficlVmGetString @142
+ficlVmGetWord @143
+ficlVmGetWord0 @144
+ficlVmGetWordToPad @145
+ficlVmInnerLoop @146
+ficlVmParseFloatNumber @147
+ficlVmParseNumber @148
+ficlVmParseString @149
+ficlVmParseStringEx @150
+ficlVmParseWord @151
+ficlVmParsePrefix @152
+ficlVmPop @153
+ficlVmPopIP @154
+ficlVmPopTib @155
+ficlVmPush @156
+ficlVmPushIP @157
+ficlVmPushTib @158
+ficlVmQuit @159
+ficlVmReset @160
+ficlVmSetTextOut @161
+ficlVmTextOut @162
+ficlVmThrow @163
+ficlVmThrowError @164
+ficlWordClassify @165
+ficlWordIsCompileOnly @166
+ficlWordIsImmediate @167
+
+;;; end-of-file
+
--- /dev/null
+++ b/ficldll.dsp
@@ -1,0 +1,219 @@
+# Microsoft Developer Studio Project File - Name="ficldll" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
+
+CFG=ficldll - Win32 Debug Multithreaded DLL
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "ficldll.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "ficldll.mak" CFG="ficldll - Win32 Debug Multithreaded DLL"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "ficldll - Win32 Release Singlethreaded" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "ficldll - Win32 Release Multithreaded" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "ficldll - Win32 Release Multithreaded DLL" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "ficldll - Win32 Debug Singlethreaded" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "ficldll - Win32 Debug Multithreaded" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "ficldll - Win32 Debug Multithreaded DLL" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName "ficldll"
+# PROP Scc_LocalPath "."
+CPP=cl.exe
+MTL=midl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "ficldll - Win32 Release Singlethreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "dll/release/singlethreaded"
+# PROP BASE Intermediate_Dir "dll/release/singlethreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "dll/release/singlethreaded"
+# PROP Intermediate_Dir "dll/release/singlethreaded"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /c
+# ADD CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /c
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
+# ADD LINK32 lib/release/singlethreaded/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /map /machine:I386 /out:"dll/release/singlethreaded/ficl.dll"
+
+!ELSEIF "$(CFG)" == "ficldll - Win32 Release Multithreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "dll/release/multithreaded"
+# PROP BASE Intermediate_Dir "dll/release/multithreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "dll/release/multithreaded"
+# PROP Intermediate_Dir "dll/release/multithreaded"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /c
+# ADD CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /c
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
+# ADD LINK32 lib/release/multithreaded/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /map /machine:I386 /out:"dll/release/multithreaded/ficl.dll"
+
+!ELSEIF "$(CFG)" == "ficldll - Win32 Release Multithreaded DLL"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "dll/release/multithreaded_dll"
+# PROP BASE Intermediate_Dir "dll/release/multithreaded_dll"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "dll/release/multithreaded_dll"
+# PROP Intermediate_Dir "dll/release/multithreaded_dll"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /c
+# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /c
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
+# ADD LINK32 lib/release/multithreaded_dll/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /map /machine:I386 /out:"dll/release/multithreaded_dll/ficl.dll"
+
+!ELSEIF "$(CFG)" == "ficldll - Win32 Debug Singlethreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "dll/debug/singlethreaded"
+# PROP BASE Intermediate_Dir "dll/debug/singlethreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "dll/debug/singlethreaded"
+# PROP Intermediate_Dir "dll/debug/singlethreaded"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /GZ /c
+# ADD CPP /nologo /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /GZ /c
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 lib/debug/singlethreaded/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /map /debug /machine:I386 /out:"dll/debug/singlethreaded/ficl.dll" /pdbtype:sept
+
+!ELSEIF "$(CFG)" == "ficldll - Win32 Debug Multithreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "dll/debug/multithreaded"
+# PROP BASE Intermediate_Dir "dll/debug/multithreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "dll/debug/multithreaded"
+# PROP Intermediate_Dir "dll/debug/multithreaded"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /GZ /c
+# ADD CPP /nologo /MTd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /GZ /c
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 lib/debug/multithreaded/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /map /debug /machine:I386 /out:"dll/debug/multithreaded/ficl.dll" /pdbtype:sept
+
+!ELSEIF "$(CFG)" == "ficldll - Win32 Debug Multithreaded DLL"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "dll/debug/multithreaded_dll"
+# PROP BASE Intermediate_Dir "dll/debug/multithreaded_dll"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "dll/debug/multithreaded_dll"
+# PROP Intermediate_Dir "dll/debug/multithreaded_dll"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /GZ /c
+# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "FICLDLL_EXPORTS" /YX /FD /GZ /c
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 lib/debug/multithreaded_dll/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /map /debug /machine:I386 /out:"dll/debug/multithreaded_dll/ficl.dll" /pdbtype:sept
+
+!ENDIF
+
+# Begin Target
+
+# Name "ficldll - Win32 Release Singlethreaded"
+# Name "ficldll - Win32 Release Multithreaded"
+# Name "ficldll - Win32 Release Multithreaded DLL"
+# Name "ficldll - Win32 Debug Singlethreaded"
+# Name "ficldll - Win32 Debug Multithreaded"
+# Name "ficldll - Win32 Debug Multithreaded DLL"
+# Begin Group "Source Files"
+
+# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat"
+# Begin Source File
+
+SOURCE=.\ficldll.def
+# End Source File
+# End Group
+# Begin Group "Header Files"
+
+# PROP Default_Filter "h;hpp;hxx;hm;inl"
+# End Group
+# Begin Group "Resource Files"
+
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
--- /dev/null
+++ b/ficlexe.dsp
@@ -1,0 +1,206 @@
+# Microsoft Developer Studio Project File - Name="ficlexe" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Console Application" 0x0103
+
+CFG=ficlexe - Win32 Debug Multithreaded DLL
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "ficlexe.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "ficlexe.mak" CFG="ficlexe - Win32 Debug Multithreaded DLL"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "ficlexe - Win32 Release Singlethreaded" (based on "Win32 (x86) Console Application")
+!MESSAGE "ficlexe - Win32 Release Multithreaded" (based on "Win32 (x86) Console Application")
+!MESSAGE "ficlexe - Win32 Release Multithreaded DLL" (based on "Win32 (x86) Console Application")
+!MESSAGE "ficlexe - Win32 Debug Singlethreaded" (based on "Win32 (x86) Console Application")
+!MESSAGE "ficlexe - Win32 Debug Multithreaded" (based on "Win32 (x86) Console Application")
+!MESSAGE "ficlexe - Win32 Debug Multithreaded DLL" (based on "Win32 (x86) Console Application")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName "ficlexe"
+# PROP Scc_LocalPath "."
+CPP=cl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "ficlexe - Win32 Release Singlethreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "exe/release/singlethreaded"
+# PROP BASE Intermediate_Dir "exe/release/singlethreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "exe/release/singlethreaded"
+# PROP Intermediate_Dir "exe/release/singlethreaded"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
+# ADD CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
+# ADD LINK32 lib/release/singlethreaded/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /map /machine:I386 /out:"exe/release/singlethreaded/ficl.exe"
+
+!ELSEIF "$(CFG)" == "ficlexe - Win32 Release Multithreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "exe/release/multithreaded"
+# PROP BASE Intermediate_Dir "exe/release/multithreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "exe/release/multithreaded"
+# PROP Intermediate_Dir "exe/release/multithreaded"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
+# ADD CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
+# ADD LINK32 lib/release/multithreaded/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /map /machine:I386 /out:"exe/release/multithreaded/ficl.exe"
+
+!ELSEIF "$(CFG)" == "ficlexe - Win32 Release Multithreaded DLL"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "exe/release/multithreaded_dll"
+# PROP BASE Intermediate_Dir "exe/release/multithreaded_dll"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "exe/release/multithreaded_dll"
+# PROP Intermediate_Dir "exe/release/multithreaded_dll"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
+# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
+# ADD LINK32 lib/release/multithreaded_dll/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /map /machine:I386 /out:"exe/release/multithreaded_dll/ficl.exe"
+
+!ELSEIF "$(CFG)" == "ficlexe - Win32 Debug Singlethreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "exe/debug/singlethreaded"
+# PROP BASE Intermediate_Dir "exe/debug/singlethreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "exe/debug/singlethreaded"
+# PROP Intermediate_Dir "exe/debug/singlethreaded"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
+# ADD CPP /nologo /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 lib/debug/singlethreaded/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /map /debug /machine:I386 /out:"exe/debug/singlethreaded/ficl.exe" /pdbtype:sept
+
+!ELSEIF "$(CFG)" == "ficlexe - Win32 Debug Multithreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "exe/debug/multithreaded"
+# PROP BASE Intermediate_Dir "exe/debug/multithreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "exe/debug/multithreaded"
+# PROP Intermediate_Dir "exe/debug/multithreaded"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
+# ADD CPP /nologo /MTd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 lib/debug/multithreaded/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /map /debug /machine:I386 /out:"exe/debug/multithreaded/ficl.exe" /pdbtype:sept
+
+!ELSEIF "$(CFG)" == "ficlexe - Win32 Debug Multithreaded DLL"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "exe/debug/multithreaded_dll"
+# PROP BASE Intermediate_Dir "exe/debug/multithreaded_dll"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "exe/debug/multithreaded_dll"
+# PROP Intermediate_Dir "exe/debug/multithreaded_dll"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
+# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 lib/debug/multithreaded_dll/ficl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /map /debug /machine:I386 /out:"exe/debug/multithreaded_dll/ficl.exe" /pdbtype:sept
+
+!ENDIF
+
+# Begin Target
+
+# Name "ficlexe - Win32 Release Singlethreaded"
+# Name "ficlexe - Win32 Release Multithreaded"
+# Name "ficlexe - Win32 Release Multithreaded DLL"
+# Name "ficlexe - Win32 Debug Singlethreaded"
+# Name "ficlexe - Win32 Debug Multithreaded"
+# Name "ficlexe - Win32 Debug Multithreaded DLL"
+# Begin Group "Source Files"
+
+# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat"
+# Begin Source File
+
+SOURCE=.\main.c
+# End Source File
+# End Group
+# Begin Group "Header Files"
+
+# PROP Default_Filter "h;hpp;hxx;hm;inl"
+# End Group
+# Begin Group "Resource Files"
+
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
--- /dev/null
+++ b/ficllib.dsp
@@ -1,0 +1,296 @@
+# Microsoft Developer Studio Project File - Name="ficllib" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Static Library" 0x0104
+
+CFG=ficllib - Win32 Debug Multithreaded DLL
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "ficllib.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "ficllib.mak" CFG="ficllib - Win32 Debug Multithreaded DLL"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "ficllib - Win32 Debug Singlethreaded" (based on "Win32 (x86) Static Library")
+!MESSAGE "ficllib - Win32 Debug Multithreaded" (based on "Win32 (x86) Static Library")
+!MESSAGE "ficllib - Win32 Debug Multithreaded DLL" (based on "Win32 (x86) Static Library")
+!MESSAGE "ficllib - Win32 Release Singlethreaded" (based on "Win32 (x86) Static Library")
+!MESSAGE "ficllib - Win32 Release Multithreaded" (based on "Win32 (x86) Static Library")
+!MESSAGE "ficllib - Win32 Release Multithreaded DLL" (based on "Win32 (x86) Static Library")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName "ficllib"
+# PROP Scc_LocalPath "."
+CPP=cl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "ficllib - Win32 Debug Singlethreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "lib/debug/singlethreaded"
+# PROP BASE Intermediate_Dir "lib/debug/singlethreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "lib/debug/singlethreaded"
+# PROP Intermediate_Dir "lib/debug/singlethreaded"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_MBCS" /D "_LIB" /YX /FD /GZ /c
+# ADD CPP /nologo /W4 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /D "_MBCS" /D "_LIB" /YX /FD /GZ /Zm200 /c
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo /out:"lib/debug/singlethreaded/ficl.lib"
+
+!ELSEIF "$(CFG)" == "ficllib - Win32 Debug Multithreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "lib/debug/multithreaded"
+# PROP BASE Intermediate_Dir "lib/debug/multithreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "lib/debug/multithreaded"
+# PROP Intermediate_Dir "lib/debug/multithreaded"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_MBCS" /D "_LIB" /YX /FD /GZ /c
+# ADD CPP /nologo /MTd /W4 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /D "_MBCS" /D "_LIB" /YX /FD /GZ /Zm200 /c
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo /out:"lib/debug/multithreaded/ficl.lib"
+
+!ELSEIF "$(CFG)" == "ficllib - Win32 Debug Multithreaded DLL"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "lib/debug/multithreaded_dll"
+# PROP BASE Intermediate_Dir "lib/debug/multithreaded_dll"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "lib/debug/multithreaded_dll"
+# PROP Intermediate_Dir "lib/debug/multithreaded_dll"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_MBCS" /D "_LIB" /YX /FD /GZ /c
+# ADD CPP /nologo /MDd /W4 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /D "_MBCS" /D "_LIB" /YX /FD /GZ /Zm200 /c
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo /out:"lib/debug/multithreaded_dll/ficl.lib"
+
+!ELSEIF "$(CFG)" == "ficllib - Win32 Release Singlethreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "lib/release/singlethreaded"
+# PROP BASE Intermediate_Dir "lib/release/singlethreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "lib/release/singlethreaded"
+# PROP Intermediate_Dir "lib/release/singlethreaded"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /YX /FD /c
+# ADD CPP /nologo /W4 /O2 /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /D FICL_ROBUST=0 /YX /FD /Zm200 /c
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo /out:"lib/release/singlethreaded/ficl.lib"
+
+!ELSEIF "$(CFG)" == "ficllib - Win32 Release Multithreaded"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "lib/release/multithreaded"
+# PROP BASE Intermediate_Dir "lib/release/multithreaded"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "lib/release/multithreaded"
+# PROP Intermediate_Dir "lib/release/multithreaded"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /YX /FD /c
+# ADD CPP /nologo /MT /W4 /O2 /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /D FICL_ROBUST=0 /YX /FD /Zm200 /c
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo /out:"lib/release/multithreaded/ficl.lib"
+
+!ELSEIF "$(CFG)" == "ficllib - Win32 Release Multithreaded DLL"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "lib/release/multithreaded_dll"
+# PROP BASE Intermediate_Dir "lib/release/multithreaded_dll"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "lib/release/multithreaded_dll"
+# PROP Intermediate_Dir "lib/release/multithreaded_dll"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /YX /FD /c
+# ADD CPP /nologo /MD /W4 /O2 /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /D FICL_ROBUST=0 /YX /FD /Zm200 /c
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo /out:"lib/release/multithreaded_dll/ficl.lib"
+
+!ENDIF
+
+# Begin Target
+
+# Name "ficllib - Win32 Debug Singlethreaded"
+# Name "ficllib - Win32 Debug Multithreaded"
+# Name "ficllib - Win32 Debug Multithreaded DLL"
+# Name "ficllib - Win32 Release Singlethreaded"
+# Name "ficllib - Win32 Release Multithreaded"
+# Name "ficllib - Win32 Release Multithreaded DLL"
+# Begin Group "Source Files"
+
+# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat"
+# Begin Source File
+
+SOURCE=.\bit.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\callback.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\compatibility.c
+# End Source File
+# Begin Source File
+
+SOURCE=dictionary.c
+# End Source File
+# Begin Source File
+
+SOURCE=double.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\extras.c
+# End Source File
+# Begin Source File
+
+SOURCE=fileaccess.c
+# End Source File
+# Begin Source File
+
+SOURCE=float.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\hash.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\lzuncompress.c
+# End Source File
+# Begin Source File
+
+SOURCE=prefix.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\primitives.c
+# End Source File
+# Begin Source File
+
+SOURCE=search.c
+# End Source File
+# Begin Source File
+
+SOURCE=softcore.c
+# End Source File
+# Begin Source File
+
+SOURCE=stack.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\system.c
+# End Source File
+# Begin Source File
+
+SOURCE=tools.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\utility.c
+# End Source File
+# Begin Source File
+
+SOURCE=vm.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\ficlplatform\win32.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\word.c
+# End Source File
+# End Group
+# Begin Group "Header Files"
+
+# PROP Default_Filter "h;hpp;hxx;hm;inl"
+# Begin Source File
+
+SOURCE=ficl.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\ficlcompatibility.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\ficllocal.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\ficltokens.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\ficlplatform\win32.h
+# End Source File
+# End Group
+# End Target
+# End Project
--- /dev/null
+++ b/ficllocal.h
@@ -1,0 +1,8 @@
+/*
+** ficllocal.h
+**
+** Put all local settings here. This file will always ship empty.
+**
+*/
+
+
--- /dev/null
+++ b/ficlplatform/ansi.c
@@ -1,0 +1,64 @@
+#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)
+ fputs(message, stdout);
+ else
+ fflush(stdout);
+ return;
+}
+
+
+/* not supported under strict ANSI C */
+int ficlFileStatus(char *filename, int *status)
+{+ *status = -1;
+ return -1;
+}
+
+
+/* gotta do it the hard way under strict ANSI C */
+long ficlFileSize(ficlFile *ff)
+{+ long currentOffset;
+ long size;
+
+ if (ff == NULL)
+ return -1;
+
+ currentOffset = ftell(ff->f);
+ fseek(ff->f, 0, SEEK_END);
+ size = ftell(ff->f);
+ fseek(ff->f, currentOffset, SEEK_SET);
+
+ return size;
+}
+
+
+
+void ficlSystemCompilePlatform(ficlSystem *system)
+{+ return;
+}
+
+
--- /dev/null
+++ b/ficlplatform/ansi.h
@@ -1,0 +1,19 @@
+#include <stdint.h>
+
+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 intptr_t ficlInteger;
+typedef uintptr_t ficlUnsigned;
+typedef float ficlFloat;
+
+#define FICL_PLATFORM_BASIC_TYPES (1)
+#define FICL_PLATFORM_HAS_2INTEGER (0)
+#define FICL_PLATFORM_HAS_FTRUNCATE (0)
+
+#define FICL_PLATFORM_OS "ansi"
+#define FICL_PLATFORM_ARCHITECTURE "unknown"
--- /dev/null
+++ b/ficlplatform/ficlexports.txt
@@ -1,0 +1,168 @@
+ficl2IntegerAbsoluteValue
+ficl2IntegerDivideFloored
+ficl2IntegerDivideSymmetric
+ficl2UnsignedDivide
+ficlAlignPointer
+ficlBitGet
+ficlBitGetString
+ficlBitSet
+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
+ficlFileTruncate
+ficlFree
+ficlHashCode
+ficlHashForget
+ficlHashInsertWord
+ficlHashLookup
+ficlHashReset
+ficlIsPowerOfTwo
+ficlLocalParen
+ficlLocalParenIm
+ficlLtoa
+ficlLzDecodeHeaderField
+ficlLzUncompress
+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
+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
+
--- /dev/null
+++ b/ficlplatform/makedef.py
@@ -1,0 +1,33 @@
+###
+### makedef.py
+### Generates a simple .DEF file for Ficl,
+### based on a text file containing all exported symbols.
+###
+### Contributed by Larry Hastings.
+###
+
+import string
+import time
+
+f = open("ficlexports.txt", "rt")+output = open("../ficldll.def", "wt")+counter = 1
+
+print >> output, ";;;"
+print >> output, ";;; Generated by makedef.py at " + time.strftime("%Y/%m/%d %H:%M:%S")+print >> output, ";;;"
+print >> output, ""
+print >> output, "EXPORTS"
+print >> output, ""
+for a in f.readlines():
+ a = string.strip(a)
+ if len(a) == 0:
+ continue
+ print >> output, a + " @" + str(counter)
+ counter += 1
+
+print >> output, ""
+print >> output, ";;; end-of-file"
+print >> output, ""
+f.close()
+output.close()
--- /dev/null
+++ b/ficlplatform/unix.c
@@ -1,0 +1,77 @@
+#include <errno.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+
+#include "ficl.h"
+
+
+
+int ficlFileTruncate(ficlFile *ff, ficlUnsigned size)
+{+ errno = EIO;
+ return -1;
+ /* return ftruncate(fileno(ff->f), size); */
+}
+
+
+
+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)
+ fputs(message, stdout);
+ else
+ fflush(stdout);
+ return;
+}
+
+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;
+}
+
+
+
+
+void ficlSystemCompilePlatform(ficlSystem *system)
+{+ return;
+}
+
+
--- /dev/null
+++ b/ficlplatform/unix.h
@@ -1,0 +1,46 @@
+#include <stdint.h>
+#include <unistd.h>
+
+
+#define FICL_WANT_PLATFORM (1)
+
+#define FICL_PLATFORM_OS "unix"
+#define FICL_PLATFORM_ARCHITECTURE "unknown"
+
+#define FICL_PLATFORM_BASIC_TYPES (1)
+#if defined(__amd64__) || defined(__alpha__)
+#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(__amd64__) || defined(__alpha__)
+#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(__amd64__) || defined(__alpha__)
+typedef ficlInteger64 ficlInteger;
+typedef ficlUnsigned64 ficlUnsigned;
+#else /* default */
+typedef intptr_t ficlInteger;
+typedef uintptr_t ficlUnsigned;
+#endif
+typedef float ficlFloat;
+
+#if defined(FICL_PLATFORM_HAS_2INTEGER) && FICL_PLATFORM_HAS_2INTEGER
+typedef ficlInteger64 ficl2Integer;
+typedef ficlUnsigned64 ficl2Unsigned;
+#endif
--- /dev/null
+++ b/ficlplatform/win32.c
@@ -1,0 +1,413 @@
+/*
+** win32.c
+** submitted to Ficl by Larry Hastings, [email protected]
+**/
+
+#include <sys/stat.h>
+#include "ficl.h"
+
+
+/*
+**
+** Heavy, undocumented wizardry here.
+**
+** In Win32, like most OSes, the buffered file I/O functions in the
+** C API (functions that take a FILE * like fopen()) are implemented
+** on top of the raw file I/O functions (functions that take an int,
+** like open()). However, in Win32, these functions in turn are
+** implemented on top of the Win32 native file I/O functions (functions
+** that take a HANDLE, like CreateFile()). This behavior is undocumented
+** but easy to deduce by reading the CRT/SRC directory.
+**
+** The below mishmash of typedefs and defines were copied from
+** CRT/SRC/INTERNAL.H from MSVC.
+**
+** --lch
+*/
+typedef struct {+ long osfhnd; /* underlying OS file HANDLE */
+ char osfile; /* attributes of file (e.g., open in text mode?) */
+ char pipech; /* one char buffer for handles opened on pipes */
+#ifdef _MT
+ int lockinitflag;
+ CRITICAL_SECTION lock;
+#endif /* _MT */
+ } ioinfo;
+extern _CRTIMP ioinfo * __pioinfo[];
+
+#define IOINFO_L2E 5
+#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
+#define _pioinfo(i) ( __pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - \
+ 1)) )
+#define _osfhnd(i) ( _pioinfo(i)->osfhnd )
+
+
+int ficlFileTruncate(ficlFile *ff, ficlUnsigned size)
+{+ HANDLE hFile = (HANDLE)_osfhnd(_fileno(ff->f));
+ if (SetFilePointer(hFile, size, NULL, FILE_BEGIN) != size)
+ return 0;
+ return !SetEndOfFile(hFile);
+}
+
+
+int ficlFileStatus(char *filename, int *status)
+{+ /*
+ ** The Windows documentation for GetFileAttributes() says it returns
+ ** INVALID_FILE_ATTRIBUTES on error. There's no such #define. The
+ ** return value for error is -1, so we'll just use that.
+ */
+ DWORD attributes = GetFileAttributes(filename);
+ if (attributes == -1)
+ {+ *status = GetLastError();
+ return -1;
+ }
+ *status = attributes;
+ return 0;
+}
+
+
+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;
+}
+
+
+
+
+
+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)
+ fputs(message, stdout);
+ else
+ fflush(stdout);
+ return;
+}
+
+
+
+/*
+**
+** Platform-specific functions
+**
+*/
+
+
+/*
+** m u l t i c a l l
+**
+** The be-all, end-all, swiss-army-chainsaw of native function call methods in Ficl.
+**
+** Usage:
+** ( x*argumentCount [this] [vtable] argumentCount floatArgumentBitfield cstringArgumentBitfield functionAddress flags -- returnValue | )
+** Note that any/all of the arguments (x*argumentCount) and the return value can use the
+** float stack instead of the data stack.
+**
+** To call a simple native function:
+** call with flags = MULTICALL_CALLTYPE_FUNCTION
+** To call a method on an object:
+** pass in the "this" pointer just below argumentCount,
+** call with flags = MULTICALL_CALLTYPE_METHOD
+** *do not* include the "this" pointer for the purposes of argumentCount
+** To call a virtual method on an object:
+** pass in the "this" pointer just below argumentCount,
+** call with flags = MULTICALL_CALLTYPE_VIRTUAL_METHOD
+** *do not* include the "this" pointer for the purposes of argumentCount
+** the function address must be the offset into the vtable for that function
+** It doesn't matter whether the function you're calling is "stdcall" (caller pops
+** the stack) or "fastcall" (callee pops the stack); for robustness, multicall
+** always restores the original stack pointer anyway.
+**
+**
+** To handle floating-point arguments:
+** To thunk an argument from the float stack instead of the data stack, set the corresponding bit
+** in the "floatArgumentBitfield" argument. Argument zero is bit 0 (1), argument one is bit 1 (2),
+** argument 2 is is bit 2 (4), argument 3 is bit 3 (8), etc. For instance, to call this function:
+** float greasyFingers(int a, float b, int c, float d)
+** you would call
+** 4 \ argumentCount
+** 2 8 or \ floatArgumentBitfield, thunk argument 2 (2) and 4 (8)
+** 0 \ cstringArgumentBitfield, don't thunk any arguments
+** (addressOfGreasyFingers) MULTICALL-CALLTYPE-FUNCTION MULTICALL-RETURNTYPE-FLOAT or multicall
+**
+** To handle automatic conversion of addr-u arguments to C-style strings:
+** This is much like handling float arguments. The bit set in cstringArgumentBitfield specifies
+** the *length* argument (the higher of the two arguments) for each addr-u you want converted.
+** You must count *both* arguments for the purposes of the argumentCount parameter.
+** For instance, to call the Win32 function MessageBoxA:
+**
+** 0 "Howdy there!" "Title" 0
+** 6 \ argument count is 6! flags text-addr text-u title-addr title-u hwnd
+** 0 \ floatArgumentBitfield, don't thunk any float arguments
+** 2 8 or \ cstringArgumentBitfield, thunk for title-u (argument 2, 2) and text-u (argument 4, 8)
+** (addressOfMessageBoxA) MULTICALL-CALLTYPE-FUNCTION MULTICALL-RETURNTYPE-INTEGER or multicall
+** The strings are copied to temporary storage and appended with a zero. These strings are freed
+** before multicall returns. If you need to call functions that write to these string buffers,
+** you'll need to handle thunking those arguments yourself.
+**
+** (If you want to call a function with more than 32 parameters, and do thunking, you need to hit somebody
+** in the head with a rock. Note: this could be you!)
+**
+** Note that, big surprise, this function is really really really dependent
+** on predefined behavior of Win32 and MSVC. It would be non-zero amounts of
+** work to port to Win64, Linux, other compilers, etc.
+**
+** --lch
+*/
+static void ficlPrimitiveMulticall(ficlVm *vm)
+{+ int flags;
+ int functionAddress;
+ int argumentCount;
+ int *thisPointer;
+ int integerReturnValue;
+#if FICL_WANT_FLOAT
+ float floatReturnValue;
+#endif /* FICL_WANT_FLOAT */
+ int cstringArguments;
+ int floatArguments;
+ int i;
+ char **fixups;
+ int fixupCount;
+ int fixupIndex;
+ int *argumentPointer;
+ int finalArgumentCount;
+ int argumentDirection;
+ int *adjustedArgumentPointer;
+ int originalESP;
+ int vtable;
+
+ flags = ficlStackPopInteger(vm->dataStack);
+
+ functionAddress = ficlStackPopInteger(vm->dataStack);
+ if (FICL_MULTICALL_GET_CALLTYPE(flags) == FICL_MULTICALL_CALLTYPE_VIRTUAL_METHOD)
+ functionAddress *= 4;
+
+ cstringArguments = ficlStackPopInteger(vm->dataStack);
+ floatArguments = ficlStackPopInteger(vm->dataStack);
+#if !FICL_WANT_FLOAT
+ FICL_VM_ASSERT(vm, !floatArguments);
+ FICL_VM_ASSERT(vm, FICL_MULTICALL_GET_RETURNTYPE(flags) != FICL_MULTICALL_RETURNTYPE_FLOAT);
+#endif /* !FICL_WANT_FLOAT */
+ argumentCount = ficlStackPopInteger(vm->dataStack);
+
+ fixupCount = 0;
+ if (cstringArguments)
+ {+ for (i = 0; i < argumentCount; i++)
+ if (cstringArguments & (1 << i))
+ fixupCount++;
+ fixups = (char **)malloc(fixupCount * sizeof(char *));
+ }
+ else
+ {+ fixups = NULL;
+ }
+
+
+ /* argumentCount does *not* include the *this* pointer! */
+ if (FICL_MULTICALL_GET_CALLTYPE(flags) != FICL_MULTICALL_CALLTYPE_FUNCTION)
+ {+ if (flags & FICL_MULTICALL_EXPLICIT_VTABLE)
+ vtable = ficlStackPopInteger(vm->dataStack);
+
+ __asm push ecx
+ thisPointer = (int *)ficlStackPopPointer(vm->dataStack);
+
+ if ((flags & FICL_MULTICALL_EXPLICIT_VTABLE) == 0)
+ vtable = *thisPointer;
+ }
+
+
+ __asm mov originalESP, esp
+
+ fixupIndex = 0;
+ finalArgumentCount = argumentCount - fixupCount;
+ __asm mov argumentPointer, esp
+ adjustedArgumentPointer = argumentPointer - finalArgumentCount;
+ __asm mov esp, adjustedArgumentPointer
+ if (flags & FICL_MULTICALL_REVERSE_ARGUMENTS)
+ {+ argumentDirection = -1;
+ argumentPointer--;
+ }
+ else
+ {+ argumentPointer = adjustedArgumentPointer;
+ argumentDirection = 1;
+ }
+
+ for (i = 0; i < argumentCount; i++)
+ {+ int argument;
+
+ /* a single argument can't be both a float and a cstring! */
+ FICL_VM_ASSERT(vm, !((floatArguments & 1) && (cstringArguments & 1)));
+
+#if FICL_WANT_FLOAT
+ if (floatArguments & 1)
+ argument = ficlStackPopInteger(vm->floatStack);
+ else
+#endif /* FICL_WANT_FLOAT */
+ argument = ficlStackPopInteger(vm->dataStack);
+
+ if (cstringArguments & 1)
+ {+ int length;
+ char *address;
+ char *buffer;
+ address = ficlStackPopPointer(vm->dataStack);
+ length = argument;
+ buffer = malloc(length + 1);
+ memcpy(buffer, address, length);
+ buffer[length] = 0;
+ fixups[fixupIndex++] = buffer;
+ argument = (int)buffer;
+ argumentCount--;
+ floatArguments >>= 1;
+ cstringArguments >>= 1;
+ }
+
+ *argumentPointer = argument;
+ argumentPointer += argumentDirection;
+
+ floatArguments >>= 1;
+ cstringArguments >>= 1;
+ }
+
+
+ /*
+ ** note! leave the "mov ecx, thisPointer" code where it is.
+ ** yes, it's duplicated in two spots.
+ ** however, MSVC likes to use ecx as a scratch variable,
+ ** so we want to set it as close as possible before the call.
+ */
+ if (FICL_MULTICALL_GET_CALLTYPE(flags) == FICL_MULTICALL_CALLTYPE_VIRTUAL_METHOD)
+ {+ __asm
+ {+ /* push thisPointer */
+ mov ecx, thisPointer
+ /* put vtable into eax. */
+ mov eax, vtable
+ /* pull out the address of the function we want... */
+ add eax, functionAddress
+ /* and call it. */
+ call [eax]
+ }
+ }
+ else
+ {+ FICL_VM_ASSERT(vm, functionAddress != 0);
+ if (FICL_MULTICALL_GET_CALLTYPE(flags))
+ {+ __asm mov ecx, thisPointer
+ }
+ __asm call functionAddress
+ }
+
+ /* save off the return value, if there is one */
+ __asm mov integerReturnValue, eax
+#if FICL_WANT_FLOAT
+ __asm fst floatReturnValue
+#endif /* FICL_WANT_FLOAT */
+
+ __asm mov esp, originalESP
+
+ if (FICL_MULTICALL_GET_CALLTYPE(flags))
+ {+ __asm pop ecx
+ }
+
+ if (FICL_MULTICALL_GET_RETURNTYPE(flags) == FICL_MULTICALL_RETURNTYPE_INTEGER)
+ ficlStackPushInteger(vm->dataStack, integerReturnValue);
+ else if (FICL_MULTICALL_GET_RETURNTYPE(flags) == FICL_MULTICALL_RETURNTYPE_CSTRING)
+ {+ char *str = (char *)(void *)integerReturnValue;
+ ficlStackPushInteger(vm->dataStack, integerReturnValue);
+ ficlStackPushInteger(vm->dataStack, strlen(str));
+ }
+#if FICL_WANT_FLOAT
+ else if (FICL_MULTICALL_GET_RETURNTYPE(flags) == FICL_MULTICALL_RETURNTYPE_FLOAT)
+ ficlStackPushFloat(vm->floatStack, floatReturnValue);
+#endif /* FICL_WANT_FLOAT */
+
+ if (fixups != NULL)
+ {+ for (i = 0; i < fixupCount; i++)
+ if (fixups[i] != NULL)
+ free(fixups[i]);
+ free(fixups);
+ }
+
+ return;
+}
+
+
+
+
+/**************************************************************************
+ f i c l C o m p i l e P l a t f o r m
+** Build Win32 platform extensions into the system dictionary
+**************************************************************************/
+void ficlSystemCompilePlatform(ficlSystem *system)
+{+ HMODULE hModule;
+ ficlDictionary *dictionary = system->dictionary;
+ FICL_SYSTEM_ASSERT(system, dictionary);
+
+ /*
+ ** one native function call to rule them all, one native function call to find them,
+ ** one native function call to bring them all and in the darkness bind them.
+ ** --lch (with apologies to j.r.r.t.)
+ */
+ ficlDictionarySetPrimitive(dictionary, "multicall", ficlPrimitiveMulticall, FICL_WORD_DEFAULT);
+ ficlDictionarySetConstant(dictionary, "multicall-calltype-function", FICL_MULTICALL_CALLTYPE_FUNCTION);
+ ficlDictionarySetConstant(dictionary, "multicall-calltype-method", FICL_MULTICALL_CALLTYPE_METHOD);
+ ficlDictionarySetConstant(dictionary, "multicall-calltype-virtual-method", FICL_MULTICALL_CALLTYPE_VIRTUAL_METHOD);
+ ficlDictionarySetConstant(dictionary, "multicall-returntype-void", FICL_MULTICALL_RETURNTYPE_VOID);
+ ficlDictionarySetConstant(dictionary, "multicall-returntype-integer", FICL_MULTICALL_RETURNTYPE_INTEGER);
+ ficlDictionarySetConstant(dictionary, "multicall-returntype-cstring", FICL_MULTICALL_RETURNTYPE_CSTRING);
+ ficlDictionarySetConstant(dictionary, "multicall-returntype-float", FICL_MULTICALL_RETURNTYPE_FLOAT);
+ ficlDictionarySetConstant(dictionary, "multicall-reverse-arguments", FICL_MULTICALL_REVERSE_ARGUMENTS);
+ ficlDictionarySetConstant(dictionary, "multicall-explit-vtable", FICL_MULTICALL_EXPLICIT_VTABLE);
+
+ /*
+ ** Every other Win32-specific word is implemented in Ficl, with multicall or whatnot.
+ ** (Give me a lever, and a place to stand, and I will move the Earth.)
+ ** See softcore/win32.fr for details. --lch
+ */
+ hModule = LoadLibrary("kernel32.dll");+ ficlDictionarySetConstantPointer(dictionary, "kernel32.dll", hModule);
+ ficlDictionarySetConstantPointer(dictionary, "(get-proc-address)", GetProcAddress(hModule, "GetProcAddress"));
+ FreeLibrary(hModule);
+
+ return;
+}
--- /dev/null
+++ b/ficlplatform/win32.h
@@ -1,0 +1,66 @@
+/*
+** Note that Microsoft's own header files won't compile without
+** "language extensions" (anonymous structs/unions) turned on.
+** And even with that, it still gives a warning in rpcasync.h:
+** warning C4115: '_RPC_ASYNC_STATE' : named type definition in parentheses
+** It compiles clean in C++. Oy vey. So I turned off the warning. --lch
+*/
+#pragma warning(disable: 4115)
+#include <windows.h>
+#pragma warning(default: 4115)
+#include <direct.h>
+
+#define FICL_WANT_PLATFORM (1)
+
+#define FICL_PLATFORM_OS "Win32"
+#define FICL_PLATFORM_ARCHITECTURE "x86"
+
+#define FICL_PLATFORM_BASIC_TYPES (1)
+#define FICL_PLATFORM_ALIGNMENT (4)
+#define FICL_PLATFORM_INLINE __inline
+
+#define FICL_PLATFORM_HAS_2INTEGER (1)
+#define FICL_PLATFORM_HAS_FTRUNCATE (1)
+
+#define fstat _fstat
+#define stat _stat
+#define getcwd _getcwd
+#define chdir _chdir
+#if !defined(__WATCOMC__)
+#define fileno _fileno
+#endif
+
+
+extern int ftruncate(int fileno, size_t size);
+
+typedef char ficlInteger8;
+typedef unsigned char ficlUnsigned8;
+typedef short ficlInteger16;
+typedef unsigned short ficlUnsigned16;
+typedef long ficlInteger32;
+typedef unsigned long ficlUnsigned32;
+typedef __int64 ficlInteger64;
+typedef unsigned __int64 ficlUnsigned64;
+
+typedef ficlInteger32 ficlInteger;
+typedef ficlUnsigned32 ficlUnsigned;
+typedef float ficlFloat;
+
+typedef ficlInteger64 ficl2Integer;
+typedef ficlUnsigned64 ficl2Unsigned;
+
+
+#define FICL_MULTICALL_CALLTYPE_FUNCTION (0)
+#define FICL_MULTICALL_CALLTYPE_METHOD (1)
+#define FICL_MULTICALL_CALLTYPE_VIRTUAL_METHOD (2)
+#define FICL_MULTICALL_GET_CALLTYPE(flags) ((flags) & 0x0f)
+
+#define FICL_MULTICALL_RETURNTYPE_VOID (0)
+#define FICL_MULTICALL_RETURNTYPE_INTEGER (16)
+#define FICL_MULTICALL_RETURNTYPE_CSTRING (32)
+#define FICL_MULTICALL_RETURNTYPE_FLOAT (48)
+#define FICL_MULTICALL_GET_RETURNTYPE(flags) ((flags) & 0xf0)
+
+#define FICL_MULTICALL_REVERSE_ARGUMENTS (1<<8)
+#define FICL_MULTICALL_EXPLICIT_VTABLE (1<<9) /* the vtable is specified on the stack */
+
--- /dev/null
+++ b/ficltokens.h
@@ -1,0 +1,228 @@
+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 **")
--- /dev/null
+++ b/fileaccess.c
@@ -1,0 +1,388 @@
+#include <errno.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <unistd.h>
+#include "ficl.h"
+
+#if FICL_WANT_FILE
+/*
+**
+** fileaccess.c
+**
+** Implements all of the File Access word set that can be implemented in portable C.
+**
+*/
+
+static void pushIor(ficlVm *vm, int success)
+{+ int ior;
+ if (success)
+ ior = 0;
+ else
+ ior = errno;
+ ficlStackPushInteger(vm->dataStack, ior);
+}
+
+
+
+static void ficlFileOpen(ficlVm *vm, char *writeMode) /* ( c-addr u fam -- fileid ior ) */
+{+ 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);
+}
+
+
+
+static void ficlPrimitiveOpenFile(ficlVm *vm) /* ( c-addr u fam -- fileid ior ) */
+{+ ficlFileOpen(vm, "a");
+}
+
+
+static void ficlPrimitiveCreateFile(ficlVm *vm) /* ( c-addr u fam -- fileid ior ) */
+{+ ficlFileOpen(vm, "w");
+}
+
+
+static int ficlFileClose(ficlFile *ff) /* ( fileid -- ior ) */
+{+ FILE *f = ff->f;
+ free(ff);
+ return !fclose(f);
+}
+
+static void ficlPrimitiveCloseFile(ficlVm *vm) /* ( fileid -- ior ) */
+{+ ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+ pushIor(vm, ficlFileClose(ff));
+}
+
+static void ficlPrimitiveDeleteFile(ficlVm *vm) /* ( c-addr u -- 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;
+
+ pushIor(vm, !unlink(filename));
+ free(filename);
+}
+
+static void ficlPrimitiveRenameFile(ficlVm *vm) /* ( c-addr1 u1 c-addr2 u2 -- ior ) */
+{+ 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);
+}
+
+static void ficlPrimitiveFileStatus(ficlVm *vm) /* ( c-addr u -- x ior ) */
+{+ 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);
+}
+
+
+static void ficlPrimitiveFilePosition(ficlVm *vm) /* ( fileid -- ud ior ) */
+{+ ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+ long ud = ftell(ff->f);
+ ficlStackPushInteger(vm->dataStack, ud);
+ pushIor(vm, ud != -1);
+}
+
+
+
+static void ficlPrimitiveFileSize(ficlVm *vm) /* ( fileid -- ud ior ) */
+{+ ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+ long ud = ficlFileSize(ff);
+ ficlStackPushInteger(vm->dataStack, ud);
+ pushIor(vm, ud != -1);
+}
+
+
+
+#define nLINEBUF 256
+static void ficlPrimitiveIncludeFile(ficlVm *vm) /* ( i*x fileid -- j*x ) */
+{+ 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);
+}
+
+
+
+static void ficlPrimitiveReadFile(ficlVm *vm) /* ( c-addr u1 fileid -- u2 ior ) */
+{+ 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);
+}
+
+
+
+static void ficlPrimitiveReadLine(ficlVm *vm) /* ( c-addr u1 fileid -- u2 flag ior ) */
+{+ 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 */
+}
+
+
+
+static void ficlPrimitiveWriteFile(ficlVm *vm) /* ( c-addr u1 fileid -- ior ) */
+{+ 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);
+}
+
+
+
+static void ficlPrimitiveWriteLine(ficlVm *vm) /* ( c-addr u1 fileid -- ior ) */
+{+ 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);
+}
+
+
+
+static void ficlPrimitiveRepositionFile(ficlVm *vm) /* ( ud fileid -- ior ) */
+{+ ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+ size_t ud = (size_t)ficlStackPopInteger(vm->dataStack);
+
+ pushIor(vm, fseek(ff->f, ud, SEEK_SET) == 0);
+}
+
+
+
+static void ficlPrimitiveFlushFile(ficlVm *vm) /* ( fileid -- ior ) */
+{+ ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
+ pushIor(vm, fflush(ff->f) == 0);
+}
+
+
+
+#if FICL_PLATFORM_HAS_FTRUNCATE
+
+static void ficlPrimitiveResizeFile(ficlVm *vm) /* ( ud fileid -- ior ) */
+{+ 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 */
+}
--- /dev/null
+++ b/float.c
@@ -1,0 +1,470 @@
+/*******************************************************************
+** f l o a t . c
+** Forth Inspired Command Language
+** ANS Forth FLOAT word-set written in C
+** Author: Guy Carver & John Sadler ([email protected])
+** Created: Apr 2001
+** $Id: float.c,v 1.13 2010/12/02 22:14:12 asau Exp $
+*******************************************************************/
+/*
+** Copyright (c) 1997-2001 John Sadler ([email protected])
+** 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 <stdlib.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <math.h>
+#include "ficl.h"
+
+#if FICL_WANT_FLOAT
+
+
+/*******************************************************************
+** 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, float value)
+{+ ficlString s;
+ FICL_STRING_SET_FROM_CSTRING(s, name);
+ return ficlDictionaryAppendConstantInstruction(dictionary, s, ficlInstructionFConstantParen, *(ficlInteger *)(&value));
+}
+
+
+ficlWord *ficlDictionarySetFConstant(ficlDictionary *dictionary, char *name, float 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, double value)
+{+ ficlString s;
+ FICL_STRING_SET_FROM_CSTRING(s, name);
+ return ficlDictionaryAppend2ConstantInstruction(dictionary, s, ficlInstructionF2ConstantParen, *(ficl2Integer *)(&value));
+}
+
+
+ficlWord *ficlDictionarySetF2Constant(ficlDictionary *dictionary, char *name, double 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)
+{+ float 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)
+{+ float 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[64];
+ sprintf(buffer, "[0x%08jx %3d] %16f (0x%08jx)\n", (uintmax_t)cell, context->count++, (double)(cell->f), (uintmax_t)cell->u);
+ 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);
+ return;
+}
+
+
+
+/*******************************************************************
+** 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;
+ float power;
+ float accum = 0.0f;
+ float 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 */
+ power = (float)pow(10.0, exponent);
+ accum *= power;
+ }
+
+ ficlStackPushFloat(vm->floatStack, accum);
+ if (vm->state == FICL_VM_STATE_COMPILE)
+ ficlPrimitiveFLiteralImmediate(vm);
+
+ return(1);
+}
+
+
+#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 */
+
+#endif /* FICL_WANT_FLOAT */
+
+/**************************************************************************
+** Add float words to a system's dictionary.
+** system -- Pointer to the Ficl sytem to add float words to.
+**************************************************************************/
+void ficlSystemCompileFloat(ficlSystem *system)
+{+#if FICL_WANT_FLOAT
+ ficlDictionary *dictionary = ficlSystemGetDictionary(system);
+ ficlDictionary *environment = ficlSystemGetEnvironment(system);
+
+ FICL_SYSTEM_ASSERT(system, dictionary);
+ FICL_SYSTEM_ASSERT(system, environment);
+
+ 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);
+
+#if FICL_WANT_LOCALS
+ ficlDictionarySetPrimitive(dictionary, "(flocal)", ficlPrimitiveFLocalParen, FICL_WORD_COMPILE_ONLY);
+ ficlDictionarySetPrimitive(dictionary, "(f2local)", ficlPrimitiveF2LocalParen, FICL_WORD_COMPILE_ONLY);
+#endif /* FICL_WANT_LOCALS */
+
+ /*
+ Missing words:
+
+ d>f
+ f>d
+ falign
+ faligned
+ float+
+ floats
+ floor
+ fmax
+ fmin
+*/
+
+ ficlDictionarySetConstant(environment, "floating", FICL_FALSE); /* not all required words are present */
+ ficlDictionarySetConstant(environment, "floating-ext", FICL_FALSE);
+ ficlDictionarySetConstant(environment, "floating-stack", system->stackSize);
+#else /* FICL_WANT_FLOAT */
+ /* get rid of unused parameter warning */
+ system = NULL;
+#endif
+ return;
+}
--- /dev/null
+++ b/hash.c
@@ -1,0 +1,163 @@
+#include <ctype.h>
+
+#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;
+ }
+
+ return;
+}
+
+
+/**************************************************************************
+ h a s h H a s h C o d e
+**
+** Generate a 16 bit hashcode from a character string using a rolling
+** shift and add stolen from PJ Weinberger of Bell Labs fame. Case folds
+** the name before hashing it...
+** N O T E : If string has zero length, returns zero.
+**************************************************************************/
+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;
+ return;
+}
+
+
+/**************************************************************************
+ h a s h L o o k u p
+** Find a name in the hash table given the hashcode and text of the name.
+** Returns the address of the corresponding 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;
+ return;
+}
+
+
--- /dev/null
+++ b/libl.i
@@ -1,0 +1,2375 @@
+#line 1 "/usr/grobe0ba/projects/ficl/main.c"
+
+#line 5 "/usr/grobe0ba/projects/ficl/main.c"
+
+#line 39 "/usr/grobe0ba/projects/ficl/main.c"
+
+#line 1 "/sys/include/ape/stdio.h"
+
+
+#pragma lib "/$M/lib/ape/libap.a"
+
+
+#line 8 "/sys/include/ape/stdio.h"
+#line 1 "/amd64/include/ape/stdarg.h"
+
+
+
+typedef char *va_list;
+
+
+#line 10 "/amd64/include/ape/stdarg.h"
+
+
+#line 19 "/amd64/include/ape/stdarg.h"
+
+#line 21 "/amd64/include/ape/stdarg.h"
+
+
+#line 9 "/sys/include/ape/stdio.h"
+#line 1 "/amd64/include/ape/stddef.h"
+
+
+
+typedef long long _ptrdiff_t;
+#line 1 "/sys/include/ape/stddef.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+typedef _ptrdiff_t ptrdiff_t;
+
+
+typedef unsigned long size_t;
+
+
+
+typedef unsigned short wchar_t;
+
+
+
+#line 6 "/amd64/include/ape/stddef.h"
+
+
+#line 10 "/sys/include/ape/stdio.h"
+#line 1 "/sys/include/ape/sys/types.h"
+
+
+
+#pragma lib "/$M/lib/ape/libap.a"
+typedef unsigned short ino_t;
+typedef unsigned short dev_t;
+typedef long long off_t;
+typedef unsigned short mode_t;
+typedef short uid_t;
+typedef short gid_t;
+typedef short nlink_t;
+typedef int pid_t;
+
+
+
+
+
+
+
+typedef long ssize_t;
+
+
+
+
+typedef long time_t;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 11 "/sys/include/ape/stdio.h"
+
+#line 31 "/sys/include/ape/stdio.h"
+typedef struct{+ int fd;
+ char flags;
+ char state;
+ char *buf;
+ char *rp;
+ char *wp;
+ char *lp;
+ size_t bufl;
+ char unbuf[1];
+}FILE;
+typedef long long fpos_t;
+
+
+
+
+
+
+
+
+#line 53 "/sys/include/ape/stdio.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+extern int remove(const char *);
+extern int rename(const char *, const char *);
+extern FILE *tmpfile(void);
+extern char *tmpnam(char *);
+extern int fclose(FILE *);
+extern int fflush(FILE *);
+extern FILE *fopen(const char *, const char *);
+extern FILE *freopen(const char *, const char *, FILE *);
+extern void setbuf(FILE *, char *);
+extern int setvbuf(FILE *, char *, int, size_t);
+extern int fprintf(FILE *, const char *, ...);
+extern int fscanf(FILE *, const char *, ...);
+extern int printf(const char *, ...);
+extern int scanf(const char *, ...);
+extern int sprintf(char *, const char *, ...);
+extern int snprintf(char *, size_t, const char *, ...);
+extern int vsnprintf(char *, size_t, const char *, va_list);
+extern int sscanf(const char *, const char *, ...);
+extern int vfprintf(FILE *, const char *, va_list);
+extern int vprintf(const char *, va_list);
+extern int vsprintf(char *, const char *, va_list);
+extern int vfscanf(FILE *, const char *, va_list);
+extern int fgetc(FILE *);
+extern char *fgets(char *, int, FILE *);
+extern int fputc(int, FILE *);
+extern int fputs(const char *, FILE *);
+extern int getc(FILE *);
+
+extern int _IO_getc(FILE *f);
+extern int getchar(void);
+
+extern char *gets(char *);
+extern int putc(int, FILE *);
+
+extern int _IO_putc(int, FILE *);
+extern int putchar(int);
+
+extern int puts(const char *);
+extern int ungetc(int, FILE *);
+extern size_t fread(void *, size_t, size_t, FILE *);
+extern size_t fwrite(const void *, size_t, size_t, FILE *);
+extern int fgetpos(FILE *, fpos_t *);
+extern int fseek(FILE *, long, int);
+extern int fseeko(FILE *, off_t, int);
+extern int fsetpos(FILE *, const fpos_t *);
+extern long ftell(FILE *);
+extern off_t ftello(FILE *);
+extern void rewind(FILE *);
+extern void clearerr(FILE *);
+extern int feof(FILE *);
+extern int ferror(FILE *);
+extern void perror(const char *);
+extern FILE _IO_stream[90];
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 41 "/usr/grobe0ba/projects/ficl/main.c"
+#line 1 "/sys/include/ape/stdlib.h"
+
+
+#pragma lib "/$M/lib/ape/libap.a"
+
+#line 1 "/amd64/include/ape/stddef.h"
+
+
+
+
+
+
+
+#line 6 "/sys/include/ape/stdlib.h"
+
+
+
+
+
+
+typedef struct { int quot, rem; } div_t;+typedef struct { long quot, rem; } ldiv_t;+
+
+
+
+
+extern double atof(const char *);
+extern int atoi(const char *);
+extern long int atol(const char *);
+extern long long atoll(const char *);
+extern double strtod(const char *, char **);
+extern long int strtol(const char *, char **, int);
+extern unsigned long int strtoul(const char *, char **, int);
+extern long long int strtoll(const char *, char **, int);
+extern unsigned long long int strtoull(const char *, char **, int);
+extern int rand(void);
+extern void srand(unsigned int seed);
+extern void *calloc(size_t, size_t);
+extern void free(void *);
+extern void *malloc(size_t);
+extern void *realloc(void *, size_t);
+extern void abort(void);
+extern int atexit(void (*func)(void));
+extern void exit(int);
+extern char *getenv(const char *);
+extern int putenv(char *);
+extern int system(const char *);
+extern void *bsearch(const void *, const void *, size_t, size_t, int (*)(const void *, const void *));
+extern void qsort(void *, size_t, size_t, int (*)(const void *, const void *));
+extern int abs(int);
+extern div_t div(int, int);
+extern long int labs(long int);
+extern ldiv_t ldiv(long int, long int);
+extern int mblen(const char *, size_t);
+extern int mbtowc(wchar_t *, const char *, size_t);
+extern int wctomb(char *, wchar_t);
+extern size_t mbstowcs(wchar_t *, const char *, size_t);
+extern size_t wcstombs(char *, const wchar_t *, size_t);
+
+
+
+
+
+
+
+
+
+
+#line 42 "/usr/grobe0ba/projects/ficl/main.c"
+
+#line 1 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+#line 43 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+#line 138 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+#line 1 "/sys/include/ape/limits.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 145 "/usr/grobe0ba/projects/ficl/./ficl.h"
+#line 1 "/sys/include/ape/setjmp.h"
+
+
+#pragma lib "/$M/lib/ape/libap.a"
+
+typedef int jmp_buf[10];
+
+
+
+
+
+
+
+
+extern int setjmp(jmp_buf);
+extern void longjmp(jmp_buf, int);
+
+
+
+
+
+
+
+
+
+
+
+#line 146 "/usr/grobe0ba/projects/ficl/./ficl.h"
+#line 1 "/amd64/include/ape/stdarg.h"
+
+
+
+
+
+
+#line 10 "/amd64/include/ape/stdarg.h"
+
+
+#line 19 "/amd64/include/ape/stdarg.h"
+
+#line 21 "/amd64/include/ape/stdarg.h"
+
+
+#line 147 "/usr/grobe0ba/projects/ficl/./ficl.h"
+#line 1 "/amd64/include/ape/stddef.h"
+
+
+
+
+
+
+
+#line 148 "/usr/grobe0ba/projects/ficl/./ficl.h"
+#line 1 "/sys/include/ape/stdio.h"
+
+
+
+
+
+#line 8 "/sys/include/ape/stdio.h"
+
+
+
+
+#line 31 "/sys/include/ape/stdio.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 53 "/sys/include/ape/stdio.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 149 "/usr/grobe0ba/projects/ficl/./ficl.h"
+#line 1 "/sys/include/ape/stdlib.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 150 "/usr/grobe0ba/projects/ficl/./ficl.h"
+#line 1 "/sys/include/ape/string.h"
+
+
+#pragma lib "/$M/lib/ape/libap.a"
+
+#line 1 "/amd64/include/ape/stddef.h"
+
+
+
+
+
+
+
+#line 6 "/sys/include/ape/string.h"
+
+
+
+
+
+extern void *memcpy(void *, const void *, size_t);
+extern void *memccpy(void*, void*, int, size_t);
+extern void *memmove(void *, const void *, size_t);
+extern char *strcpy(char *, const char *);
+extern char *strncpy(char *, const char *, size_t);
+extern char *strcat(char *, const char *);
+extern char *strncat(char *, const char *, size_t);
+extern int memcmp(const void *, const void *, size_t);
+extern int strcmp(const char *, const char *);
+extern int strcoll(const char *, const char *);
+extern char *strdup(char*);
+extern char *strndup(char*, size_t);
+extern int strncmp(const char *, const char *, size_t);
+extern size_t strxfrm(char *, const char *, size_t);
+extern void *memchr(const void *, int, size_t);
+extern char *strchr(const char *, int);
+extern size_t strcspn(const char *, const char *);
+extern char *strpbrk(const char *, const char *);
+extern char *strrchr(const char *, int);
+extern size_t strspn(const char *, const char *);
+extern char *strstr(const char *, const char *);
+extern char *strtok(char *, const char *);
+extern void *memset(void *, int, size_t);
+extern char *strerror(int);
+extern size_t strlen(const char *);
+extern size_t strnlen(const char *, size_t);
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 151 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+#line 157 "/usr/grobe0ba/projects/ficl/./ficl.h"
+#line 1 "/usr/grobe0ba/projects/ficl/./ficllocal.h"
+
+#line 7 "/usr/grobe0ba/projects/ficl/./ficllocal.h"
+
+
+#line 158 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+
+
+#line 1 "/usr/grobe0ba/projects/ficl/./ficlplatform/ansi.h"
+#line 1 "/amd64/include/ape/stdint.h"
+
+
+
+typedef long long _intptr_t;
+typedef unsigned long long _uintptr_t;
+
+#line 1 "/sys/include/ape/stdint.h"
+
+
+
+
+#line 8 "/sys/include/ape/stdint.h"
+
+
+
+
+
+typedef char int8_t;
+typedef short int16_t;
+typedef int int32_t;
+typedef long long int64_t;
+typedef long long intmax_t;
+typedef unsigned char uint8_t;
+typedef unsigned short uint16_t;
+typedef unsigned int uint32_t;
+typedef unsigned long long uint64_t;
+typedef unsigned long long uintmax_t;
+
+typedef int8_t int_fast8_t;
+typedef int16_t int_fast16_t;
+typedef int32_t int_fast32_t;
+typedef int64_t int_fast64_t;
+;
+typedef int8_t int_least8_t;
+typedef int16_t int_least16_t;
+typedef int32_t int_least32_t;
+typedef int64_t int_least64_t;
+
+typedef uint8_t uint_fast8_t;
+typedef uint16_t uint_fast16_t;
+typedef uint32_t uint_fast32_t;
+typedef uint64_t uint_fast64_t;
+
+typedef uint8_t uint_least8_t;
+typedef uint16_t uint_least16_t;
+typedef uint32_t uint_least32_t;
+typedef uint64_t uint_least64_t;
+
+typedef _intptr_t intptr_t;
+typedef _uintptr_t uintptr_t;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 115 "/sys/include/ape/stdint.h"
+
+
+
+
+#line 8 "/amd64/include/ape/stdint.h"
+
+
+#line 2 "/usr/grobe0ba/projects/ficl/./ficlplatform/ansi.h"
+
+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 intptr_t ficlInteger;
+typedef uintptr_t ficlUnsigned;
+typedef float ficlFloat;
+
+
+
+
+
+
+
+#line 170 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 183 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+#line 188 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 214 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+#line 227 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+#line 252 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+#line 263 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 272 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 280 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 289 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 300 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 309 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 318 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 326 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 341 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+#line 353 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+#line 365 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+#line 377 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+#line 383 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 391 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 409 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 426 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+#line 439 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 451 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+#line 462 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 490 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+#line 502 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 511 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 519 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 528 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 538 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 548 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 556 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 563 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 571 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+#line 579 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+
+#line 591 "/usr/grobe0ba/projects/ficl/./ficl.h"
+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;
+
+
+
+#line 620 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern void ficlCallbackDefaultTextOut(ficlCallback *callback, char *text);
+ extern void *ficlMalloc (size_t size);
+ extern void ficlFree (void *p);
+ extern void *ficlRealloc(void *p, size_t size);
+
+
+
+
+
+
+
+#line 633 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+#line 644 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 667 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+
+#line 679 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+typedef struct
+{+ ficlUnsigned high;
+ ficlUnsigned low;
+} ficl2Unsigned;
+
+typedef struct
+{+ ficlInteger high;
+ ficlInteger low;
+} ficl2Integer;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ extern int ficl2IntegerIsNegative(ficl2Integer x);
+ extern ficl2Integer ficl2IntegerNegate(ficl2Integer x);
+
+ extern ficl2Integer ficl2IntegerMultiply(ficlInteger x, ficlInteger y);
+ extern ficl2Integer ficl2IntegerDecrement(ficl2Integer x);
+
+ extern ficl2Unsigned ficl2UnsignedAdd(ficl2Unsigned x, ficl2Unsigned y);
+ extern ficl2Unsigned ficl2UnsignedSubtract(ficl2Unsigned x, ficl2Unsigned y);
+ extern ficl2Unsigned ficl2UnsignedMultiply(ficlUnsigned x, ficlUnsigned y);
+ extern ficl2Unsigned ficl2UnsignedMultiplyAccumulate(ficl2Unsigned u, ficlUnsigned mul, ficlUnsigned add);
+ extern ficl2Unsigned ficl2UnsignedArithmeticShiftLeft( ficl2Unsigned x );
+ extern ficl2Unsigned ficl2UnsignedArithmeticShiftRight( ficl2Unsigned x );
+ extern int ficl2UnsignedCompare(ficl2Unsigned x, ficl2Unsigned y);
+ extern ficl2Unsigned ficl2UnsignedOr( ficl2Unsigned x, ficl2Unsigned y );
+
+
+
+ extern ficl2Integer ficl2IntegerAbsoluteValue(ficl2Integer x);
+
+
+#line 759 "/usr/grobe0ba/projects/ficl/./ficl.h"
+typedef struct
+{+ ficl2Unsigned quotient;
+ ficlUnsigned remainder;
+} ficl2UnsignedQR;
+
+typedef struct
+{+ ficl2Integer quotient;
+ ficlInteger remainder;
+} ficl2IntegerQR;
+
+
+
+
+
+
+#line 782 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern ficl2IntegerQR ficl2IntegerDivideFloored(ficl2Integer num, ficlInteger den);
+ extern ficl2IntegerQR ficl2IntegerDivideSymmetric(ficl2Integer num, ficlInteger den);
+
+ extern ficl2UnsignedQR ficl2UnsignedDivide(ficl2Unsigned q, ficlUnsigned y);
+
+
+
+
+
+
+
+#line 802 "/usr/grobe0ba/projects/ficl/./ficl.h"
+typedef union ficlCell
+{+ ficlInteger i;
+ ficlUnsigned u;
+
+ ficlFloat f;
+
+ void *p;
+ void (*fn)(void);
+} ficlCell;
+
+
+
+
+
+#line 823 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+#line 834 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+#line 841 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+#line 862 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+struct ficlCountedString
+{+ ficlUnsigned8 length;
+ char text[1];
+};
+
+
+
+
+
+
+
+struct ficlString
+{+ ficlUnsigned length;
+ char *text;
+};
+
+
+
+
+
+
+
+#line 888 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+#line 891 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+#line 893 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+#line 908 "/usr/grobe0ba/projects/ficl/./ficl.h"
+typedef struct
+{+ ficlInteger index;
+ char *end;
+ char *text;
+} ficlTIB;
+
+
+
+#line 925 "/usr/grobe0ba/projects/ficl/./ficl.h"
+typedef struct ficlStack
+{+ ficlUnsigned size;
+ ficlCell *frame;
+ ficlCell *top;
+ ficlVm *vm;
+ char *name;
+ ficlCell *base;
+} ficlStack;
+
+
+#line 938 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern ficlStack *ficlStackCreate (ficlVm *vm, char *name, unsigned nCells);
+ extern void ficlStackDestroy (ficlStack *stack);
+ extern int ficlStackDepth (ficlStack *stack);
+ extern void ficlStackDrop (ficlStack *stack, int n);
+ extern ficlCell ficlStackFetch (ficlStack *stack, int n);
+ extern ficlCell ficlStackGetTop (ficlStack *stack);
+ extern void ficlStackPick (ficlStack *stack, int n);
+ extern ficlCell ficlStackPop (ficlStack *stack);
+ extern void ficlStackPush (ficlStack *stack, ficlCell c);
+ extern void ficlStackReset (ficlStack *stack);
+ extern void ficlStackRoll (ficlStack *stack, int n);
+ extern void ficlStackSetTop (ficlStack *stack, ficlCell c);
+ extern void ficlStackStore (ficlStack *stack, int n, ficlCell c);
+
+
+ extern void ficlStackLink (ficlStack *stack, int nCells);
+ extern void ficlStackUnlink (ficlStack *stack);
+
+
+ extern void *ficlStackPopPointer (ficlStack *stack);
+ extern ficlUnsigned ficlStackPopUnsigned (ficlStack *stack);
+ extern ficlInteger ficlStackPopInteger (ficlStack *stack);
+ extern void ficlStackPushPointer (ficlStack *stack, void *ptr);
+ extern void ficlStackPushUnsigned (ficlStack *stack, ficlUnsigned u);
+ extern void ficlStackPushInteger (ficlStack *stack, ficlInteger i);
+
+
+ extern ficlFloat ficlStackPopFloat (ficlStack *stack);
+ extern void ficlStackPushFloat (ficlStack *stack, ficlFloat f);
+
+
+ extern void ficlStackPush2Integer (ficlStack *stack, ficl2Integer i64);
+ extern ficl2Integer ficlStackPop2Integer (ficlStack *stack);
+ extern void ficlStackPush2Unsigned(ficlStack *stack, ficl2Unsigned u64);
+ extern ficl2Unsigned ficlStackPop2Unsigned (ficlStack *stack);
+
+
+
+ extern void ficlStackCheck (ficlStack *stack, int popCells, int pushCells);
+
+
+
+
+
+typedef ficlInteger (*ficlStackWalkFunction)(void *constant, ficlCell *cell);
+ extern void ficlStackWalk(ficlStack *stack, ficlStackWalkFunction callback, void *context, ficlInteger bottomToTop);
+ extern void ficlStackDisplay(ficlStack *stack, ficlStackWalkFunction callback, void *context);
+
+
+typedef ficlWord **ficlIp;
+typedef void (*ficlPrimitive)(ficlVm *vm);
+typedef void (*ficlOutputFunction)(ficlCallback *callback, char *text);
+
+
+
+#line 1001 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+struct ficlCallback
+{+ void *context;
+ ficlOutputFunction textOut;
+ ficlOutputFunction errorOut;
+ ficlSystem *system;
+ ficlVm *vm;
+};
+
+ extern void ficlCallbackTextOut(ficlCallback *callback, char *text);
+ extern void ficlCallbackErrorOut(ficlCallback *callback, char *text);
+
+
+#line 1017 "/usr/grobe0ba/projects/ficl/./ficl.h"
+typedef void (*ficlCompatibilityOutputFunction)(ficlVm *vm, char *text, int newline);
+ extern void ficlCompatibilityTextOutCallback(ficlCallback *callback, char *text, ficlCompatibilityOutputFunction oldFunction);
+
+
+
+
+#line 1028 "/usr/grobe0ba/projects/ficl/./ficl.h"
+enum ficlInstruction
+{+
+
+#line 1 "/usr/grobe0ba/projects/ficl/./ficltokens.h"
+ ficlInstructionInvalid,
+ ficlInstruction1,
+ ficlInstruction2,
+ ficlInstruction3,
+ ficlInstruction4,
+ ficlInstruction5,
+ ficlInstruction6,
+ ficlInstruction7,
+ ficlInstruction8,
+ ficlInstruction9,
+ ficlInstruction10,
+ ficlInstruction11,
+ ficlInstruction12,
+ ficlInstruction13,
+ ficlInstruction14,
+ ficlInstruction15,
+ ficlInstruction16,
+ ficlInstruction0,
+ ficlInstructionNeg1,
+ ficlInstructionNeg2,
+ ficlInstructionNeg3,
+ ficlInstructionNeg4,
+ ficlInstructionNeg5,
+ ficlInstructionNeg6,
+ ficlInstructionNeg7,
+ ficlInstructionNeg8,
+ ficlInstructionNeg9,
+ ficlInstructionNeg10,
+ ficlInstructionNeg11,
+ ficlInstructionNeg12,
+ ficlInstructionNeg13,
+ ficlInstructionNeg14,
+ ficlInstructionNeg15,
+ ficlInstructionNeg16,
+
+ ficlInstructionF0,
+ ficlInstructionF1,
+ ficlInstructionFNeg1,
+
+ ficlInstructionPlus,
+ ficlInstructionMinus,
+ ficlInstruction1Plus,
+ ficlInstruction1Minus,
+ ficlInstruction2Plus,
+ ficlInstruction2Minus,
+ ficlInstructionSemiParen,
+ ficlInstructionExitParen,
+ ficlInstructionDup,
+ ficlInstructionSwap,
+ ficlInstructionGreaterThan,
+ ficlInstructionBranchParenWithCheck,
+ ficlInstructionBranchParen,
+ ficlInstructionBranch0ParenWithCheck,
+ ficlInstructionBranch0Paren,
+ ficlInstructionLiteralParen,
+ ficlInstructionLoopParen,
+ ficlInstructionOfParen,
+ ficlInstructionPlusLoopParen,
+ ficlInstructionFetch,
+ ficlInstructionStore,
+ ficlInstructionComma,
+ ficlInstructionCComma,
+ ficlInstructionCells,
+ ficlInstructionCellPlus,
+ ficlInstructionNegate,
+ ficlInstructionStar,
+ ficlInstructionSlash,
+ ficlInstructionStarSlash,
+ ficlInstructionSlashMod,
+ ficlInstructionStarSlashMod,
+ ficlInstruction2Star,
+ ficlInstruction2Slash,
+
+ ficlInstructionColonParen,
+ ficlInstructionVariableParen,
+ ficlInstructionConstantParen,
+ ficlInstruction2ConstantParen,
+ ficlInstruction2LiteralParen,
+ ficlInstructionDoDoes,
+ ficlInstructionDoParen,
+ ficlInstructionDoesParen,
+ ficlInstructionQDoParen,
+ ficlInstructionCreateParen,
+ ficlInstructionStringLiteralParen,
+ ficlInstructionCStringLiteralParen,
+
+ ficlInstructionPlusStore,
+ ficlInstruction0Less,
+ ficlInstruction0Greater,
+ ficlInstruction0Equals,
+ ficlInstruction2Store,
+ ficlInstruction2Fetch,
+ ficlInstructionOver,
+ ficlInstructionRot,
+ ficlInstruction2Drop,
+ ficlInstruction2Dup,
+ ficlInstruction2Over,
+ ficlInstruction2Swap,
+ ficlInstructionFromRStack,
+ ficlInstructionFetchRStack,
+ ficlInstruction2ToR,
+ ficlInstruction2RFrom,
+ ficlInstruction2RFetch,
+ ficlInstructionLess,
+ ficlInstructionEquals,
+ ficlInstructionToRStack,
+ ficlInstructionQuestionDup,
+ ficlInstructionAnd,
+ ficlInstructionCStore,
+ ficlInstructionCFetch,
+ ficlInstructionDrop,
+ ficlInstructionPick,
+ ficlInstructionRoll,
+ ficlInstructionMinusRoll,
+ ficlInstructionMinusRot,
+ ficlInstructionFill,
+ ficlInstructionSToD,
+ ficlInstructionULess,
+
+ ficlInstructionQuadFetch,
+ ficlInstructionQuadStore,
+ ficlInstructionWFetch,
+ ficlInstructionWStore,
+
+ ficlInstructionInvert,
+ ficlInstructionLShift,
+ ficlInstructionMax,
+ ficlInstructionMin,
+ ficlInstructionMove,
+ ficlInstructionOr,
+ ficlInstructionRShift,
+ ficlInstructionXor,
+
+ ficlInstructionI,
+ ficlInstructionJ,
+ ficlInstructionK,
+
+ ficlInstructionCompare,
+ ficlInstructionCompareInsensitive,
+ ficlInstructionRandom,
+ ficlInstructionSeedRandom,
+
+ ficlInstructionLeave,
+ ficlInstructionUnloop,
+
+
+ ficlInstructionUserParen,
+
+
+
+ ficlInstructionLinkParen,
+ ficlInstructionUnlinkParen,
+
+ ficlInstructionGetLocalParen,
+ ficlInstructionGet2LocalParen,
+ ficlInstructionToLocalParen,
+ ficlInstructionTo2LocalParen,
+
+ ficlInstructionGetLocal0,
+ ficlInstructionGet2Local0,
+ ficlInstructionToLocal0,
+ ficlInstructionTo2Local0,
+
+ ficlInstructionGetLocal1,
+ ficlInstructionToLocal1,
+
+
+ ficlInstructionGetFLocalParen,
+ ficlInstructionGetF2LocalParen,
+ ficlInstructionToFLocalParen,
+ ficlInstructionToF2LocalParen,
+
+
+
+
+
+ ficlInstructionFLiteralParen,
+ ficlInstructionFConstantParen,
+ ficlInstructionF2ConstantParen,
+
+ ficlInstructionFPlus,
+ ficlInstructionFMinus,
+ ficlInstructionFStar,
+ ficlInstructionFSlash,
+ ficlInstructionFNegate,
+ ficlInstructionFPlusI,
+ ficlInstructionFMinusI,
+ ficlInstructionFStarI,
+ ficlInstructionFSlashI,
+ ficlInstructionIMinusF,
+ ficlInstructionISlashF,
+
+ ficlInstructionFFrom,
+ ficlInstructionToF,
+ ficlInstructionIntToFloat,
+ ficlInstructionFloatToInt,
+
+ ficlInstructionFFetch,
+ ficlInstructionFStore,
+ ficlInstructionF2Fetch,
+ ficlInstructionF2Store,
+ ficlInstructionFPlusStore,
+
+ ficlInstructionFDrop,
+ ficlInstructionF2Drop,
+ ficlInstructionFDup,
+ ficlInstructionF2Dup,
+ ficlInstructionFMinusRoll,
+ ficlInstructionFMinusRot,
+ ficlInstructionFQuestionDup,
+ ficlInstructionFOver,
+ ficlInstructionF2Over,
+ ficlInstructionFPick,
+ ficlInstructionFRoll,
+ ficlInstructionFRot,
+ ficlInstructionFSwap,
+ ficlInstructionF2Swap,
+
+ ficlInstructionF0Less,
+ ficlInstructionFLess,
+ ficlInstructionF0Equals,
+ ficlInstructionFEquals,
+ ficlInstructionF0Greater,
+ ficlInstructionFGreater,
+
+
+
+ ficlInstructionExitInnerLoop,
+#line 1033 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+ ficlInstructionLast,
+
+ ficlInstructionFourByteTrick = 0x10000000
+};
+typedef ficlInteger ficlInstruction;
+
+
+
+#line 1054 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+struct ficlVm
+{+ ficlCallback callback;
+ ficlVm *link;
+ jmp_buf *exceptionHandler;
+ short restart;
+ ficlIp ip;
+ ficlWord *runningWord;
+ ficlUnsigned state;
+ ficlUnsigned base;
+ ficlStack *dataStack;
+ ficlStack *returnStack;
+
+ ficlStack *floatStack;
+
+ ficlCell sourceId;
+ ficlTIB tib;
+
+ ficlCell user[(16)];
+
+ char pad[(256)];
+
+
+
+};
+
+
+
+#line 1090 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+#line 1098 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+
+
+ extern void ficlVmBranchRelative(ficlVm *vm, int offset);
+ extern ficlVm * ficlVmCreate (ficlVm *vm, unsigned nPStack, unsigned nRStack);
+ extern void ficlVmDestroy (ficlVm *vm);
+ extern ficlDictionary *ficlVmGetDictionary(ficlVm *vm);
+ extern char * ficlVmGetString (ficlVm *vm, ficlCountedString *spDest, char delimiter);
+ extern ficlString ficlVmGetWord (ficlVm *vm);
+ extern ficlString ficlVmGetWord0 (ficlVm *vm);
+ extern int ficlVmGetWordToPad (ficlVm *vm);
+ extern void ficlVmInnerLoop (ficlVm *vm, ficlWord *word);
+ extern ficlString ficlVmParseString (ficlVm *vm, char delimiter);
+ extern ficlString ficlVmParseStringEx(ficlVm *vm, char delimiter, char fSkipLeading);
+ extern ficlCell ficlVmPop (ficlVm *vm);
+ extern void ficlVmPush (ficlVm *vm, ficlCell c);
+ extern void ficlVmPopIP (ficlVm *vm);
+ extern void ficlVmPushIP (ficlVm *vm, ficlIp newIP);
+ extern void ficlVmQuit (ficlVm *vm);
+ extern void ficlVmReset (ficlVm *vm);
+ extern void ficlVmSetTextOut (ficlVm *vm, ficlOutputFunction textOut);
+ extern void ficlVmThrow (ficlVm *vm, int except);
+ extern void ficlVmThrowError (ficlVm *vm, char *fmt, ...);
+ extern void ficlVmThrowErrorVararg(ficlVm *vm, char *fmt, va_list list);
+ extern void ficlVmTextOut (ficlVm *vm, char *text);
+ extern void ficlVmErrorOut (ficlVm *vm, char *text);
+
+
+
+
+
+
+
+ extern void ficlVmDisplayDataStack(ficlVm *vm);
+ extern void ficlVmDisplayDataStackSimple(ficlVm *vm);
+ extern void ficlVmDisplayReturnStack(ficlVm *vm);
+
+ extern void ficlVmDisplayFloatStack(ficlVm *vm);
+
+
+
+#line 1154 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern int ficlVmEvaluate(ficlVm *vm, char *s);
+
+
+#line 1182 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern int ficlVmExecuteString(ficlVm *vm, ficlString s);
+ extern int ficlVmExecuteXT(ficlVm *vm, ficlWord *pWord);
+ extern void ficlVmExecuteInstruction(ficlVm *vm, ficlInstruction i);
+ extern void ficlVmExecuteWord(ficlVm *vm, ficlWord *pWord);
+
+ extern void ficlVmDictionaryAllot(ficlVm *vm, ficlDictionary *dictionary, int n);
+ extern void ficlVmDictionaryAllotCells(ficlVm *vm, ficlDictionary *dictionary, int cells);
+
+ extern int ficlVmParseWord(ficlVm *vm, ficlString s);
+
+
+
+
+#line 1204 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern void ficlVmPushTib (ficlVm *vm, char *text, ficlInteger nChars, ficlTIB *pSaveTib);
+ extern void ficlVmPopTib (ficlVm *vm, ficlTIB *pTib);
+
+
+
+
+
+
+
+
+ extern void ficlVmDictionaryCheck(ficlVm *vm, ficlDictionary *dictionary, int n);
+ extern void ficlVmDictionarySimpleCheck(ficlVm *vm, ficlDictionary *dictionary, int n);
+
+
+
+
+
+
+
+
+
+ extern void ficlPrimitiveLiteralIm(ficlVm *vm);
+
+
+#line 1238 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+#line 1248 "/usr/grobe0ba/projects/ficl/./ficl.h"
+struct ficlWord
+{+ struct ficlWord *link;
+ ficlUnsigned16 hash;
+ ficlUnsigned8 flags;
+ ficlUnsigned8 length;
+ char *name;
+ ficlPrimitive code;
+ ficlInstruction semiParen;
+ ficlCell param[1];
+};
+
+
+#line 1263 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+#line 1269 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+#line 1277 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+#line 1285 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+#line 1292 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+#line 1304 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+#line 1311 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+#line 1318 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+#line 1321 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+ extern int ficlWordIsImmediate(ficlWord *word);
+ extern int ficlWordIsCompileOnly(ficlWord *word);
+
+
+
+
+
+ extern void ficlCallbackAssert(ficlCallback *callback, int expression, char *expressionString, char *filename, int line);
+
+
+
+
+
+
+
+
+
+
+
+#line 1344 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+ extern int ficlIsPowerOfTwo(ficlUnsigned u);
+
+ extern char *ficlLtoa(ficlInteger value, char *string, int radix );
+ extern char *ficlUltoa(ficlUnsigned value, char *string, int radix );
+ extern char ficlDigitToCharacter(int value);
+ extern char *ficlStringReverse( char *string );
+ extern char *ficlStringSkipSpace(char *s, char *end);
+ extern char *ficlStringCaseFold(char *s);
+ extern int ficlStrincmp(char *s1, char *s2, ficlUnsigned length);
+ extern void *ficlAlignPointer(void *ptr);
+
+
+
+#line 1364 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+typedef struct ficlHash
+{+ struct ficlHash *link;
+ char *name;
+ unsigned size;
+ ficlWord *table[1];
+} ficlHash;
+
+ extern void ficlHashForget (ficlHash *hash, void *where);
+ extern ficlUnsigned16 ficlHashCode (ficlString s);
+ extern void ficlHashInsertWord(ficlHash *hash, ficlWord *word);
+ extern ficlWord *ficlHashLookup (ficlHash *hash, ficlString name, ficlUnsigned16 hashCode);
+ extern void ficlHashReset (ficlHash *hash);
+
+
+#line 1410 "/usr/grobe0ba/projects/ficl/./ficl.h"
+struct ficlDictionary
+{+ ficlCell *here;
+ void *context;
+ ficlWord *smudge;
+ ficlHash *forthWordlist;
+ ficlHash *compilationWordlist;
+ ficlHash *wordlists[(16)];
+ int wordlistCount;
+ unsigned size;
+ ficlSystem *system;
+ ficlCell base[1];
+};
+
+ extern void ficlDictionaryAbortDefinition(ficlDictionary *dictionary);
+ extern void ficlDictionaryAlign (ficlDictionary *dictionary);
+ extern void ficlDictionaryAllot (ficlDictionary *dictionary, int n);
+ extern void ficlDictionaryAllotCells (ficlDictionary *dictionary, int nCells);
+ extern void ficlDictionaryAppendCell (ficlDictionary *dictionary, ficlCell c);
+ extern void ficlDictionaryAppendCharacter(ficlDictionary *dictionary, char c);
+ extern void ficlDictionaryAppendUnsigned(ficlDictionary *dictionary, ficlUnsigned u);
+ extern void *ficlDictionaryAppendData(ficlDictionary *dictionary, void *data, ficlInteger length);
+ extern char *ficlDictionaryAppendString(ficlDictionary *dictionary, ficlString s);
+ extern ficlWord *ficlDictionaryAppendWord(ficlDictionary *dictionary,
+ ficlString name,
+ ficlPrimitive pCode,
+ ficlUnsigned8 flags);
+ extern ficlWord *ficlDictionaryAppendPrimitive(ficlDictionary *dictionary,
+ char *name,
+ ficlPrimitive pCode,
+ ficlUnsigned8 flags);
+ extern ficlWord *ficlDictionaryAppendInstruction(ficlDictionary *dictionary,
+ char *name,
+ ficlInstruction i,
+ ficlUnsigned8 flags);
+
+ extern ficlWord *ficlDictionaryAppendConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficlInteger value);
+ extern ficlWord *ficlDictionaryAppend2ConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficl2Integer value);
+
+ extern ficlWord *ficlDictionaryAppendConstant(ficlDictionary *dictionary, char *name, ficlInteger value);
+ extern ficlWord *ficlDictionaryAppend2Constant(ficlDictionary *dictionary, char *name, ficl2Integer value);
+
+#line 1453 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+ extern ficlWord *ficlDictionaryAppendFConstant(ficlDictionary *dictionary, char *name, float value);
+ extern ficlWord *ficlDictionaryAppendF2Constant(ficlDictionary *dictionary, char *name, double value);
+
+
+
+ extern ficlWord *ficlDictionarySetConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficlInteger value);
+ extern ficlWord *ficlDictionarySet2ConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficl2Integer value);
+
+ extern ficlWord *ficlDictionarySetConstant(ficlDictionary *dictionary, char *name, ficlInteger value);
+
+#line 1465 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern ficlWord *ficlDictionarySet2Constant(ficlDictionary *dictionary, char *name, ficl2Integer value);
+ extern ficlWord *ficlDictionarySetConstantString(ficlDictionary *dictionary, char *name, char *value);
+ extern ficlWord *ficlDictionarySetPrimitive(ficlDictionary *dictionary,
+ char *name,
+ ficlPrimitive code,
+ ficlUnsigned8 flags);
+ extern ficlWord *ficlDictionarySetInstruction(ficlDictionary *dictionary,
+ char *name,
+ ficlInstruction i,
+ ficlUnsigned8 flags);
+
+ extern ficlWord *ficlDictionarySetFConstant(ficlDictionary *dictionary, char *name, float value);
+ extern ficlWord *ficlDictionarySetF2Constant(ficlDictionary *dictionary, char *name, double value);
+
+
+ extern int ficlDictionaryCellsAvailable (ficlDictionary *dictionary);
+ extern int ficlDictionaryCellsUsed (ficlDictionary *dictionary);
+ extern ficlDictionary *ficlDictionaryCreate(ficlSystem *system, unsigned nCELLS);
+ extern ficlDictionary *ficlDictionaryCreateHashed(ficlSystem *system, unsigned nCells, unsigned nHash);
+ extern ficlHash *ficlDictionaryCreateWordlist(ficlDictionary *dictionary, int nBuckets);
+ extern void ficlDictionaryDestroy (ficlDictionary *dictionary);
+ extern void ficlDictionaryEmpty (ficlDictionary *dictionary, unsigned nHash);
+ extern int ficlDictionaryIncludes (ficlDictionary *dictionary, void *p);
+ extern ficlWord *ficlDictionaryLookup (ficlDictionary *dictionary, ficlString name);
+ extern void ficlDictionaryResetSearchOrder(ficlDictionary *dictionary);
+ extern void ficlDictionarySetFlags (ficlDictionary *dictionary, ficlUnsigned8 set);
+ extern void ficlDictionaryClearFlags(ficlDictionary *dictionary, ficlUnsigned8 clear);
+ extern void ficlDictionarySetImmediate(ficlDictionary *dictionary);
+ extern void ficlDictionaryUnsmudge (ficlDictionary *dictionary);
+ extern ficlCell *ficlDictionaryWhere (ficlDictionary *dictionary);
+
+ extern int ficlDictionaryIsAWord(ficlDictionary *dictionary, ficlWord *word);
+ extern void ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word, ficlCallback *callback);
+ extern ficlWord *ficlDictionaryFindEnclosingWord(ficlDictionary *dictionary, ficlCell *cell);
+
+
+#line 1515 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+#line 1542 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+typedef int (*ficlParseStep)(ficlVm *vm, ficlString s);
+
+
+#line 1555 "/usr/grobe0ba/projects/ficl/./ficl.h"
+typedef struct ficlBreakpoint
+{+ void *address;
+ ficlWord *oldXT;
+} ficlBreakpoint;
+
+
+
+#line 1571 "/usr/grobe0ba/projects/ficl/./ficl.h"
+struct ficlSystemInformation
+{+ int size;
+ void *context;
+ int dictionarySize;
+ int stackSize;
+ ficlOutputFunction textOut;
+ ficlOutputFunction errorOut;
+ int environmentSize;
+};
+
+
+#line 1584 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+struct ficlSystem
+{+ ficlCallback callback;
+ ficlSystem *link;
+ ficlVm *vmList;
+ ficlDictionary *dictionary;
+ ficlDictionary *environment;
+
+ ficlInstruction interpreterLoop[3];
+ ficlWord *parseList[(8)];
+
+ ficlWord *exitInnerWord;
+ ficlWord *interpretWord;
+
+
+ ficlDictionary *locals;
+ ficlInteger localsCount;
+ ficlCell *localsFixup;
+
+
+ ficlInteger stackSize;
+
+ ficlBreakpoint breakpoint;
+
+
+
+};
+
+
+
+
+
+
+#line 1623 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+#line 1636 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern ficlSystem *ficlSystemCreate(ficlSystemInformation *fsi);
+
+
+#line 1644 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern void ficlSystemDestroy(ficlSystem *system);
+
+
+#line 1652 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern ficlVm *ficlSystemCreateVm(ficlSystem *system);
+
+
+#line 1661 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern void ficlSystemDestroyVm(ficlVm *vm);
+
+
+
+#line 1669 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern ficlWord *ficlSystemLookup(ficlSystem *system, char *name);
+
+
+#line 1676 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ficlDictionary *ficlSystemGetDictionary(ficlSystem *system);
+ficlDictionary *ficlSystemGetEnvironment(ficlSystem *system);
+
+ficlDictionary *ficlSystemGetLocals(ficlSystem *system);
+
+
+
+#line 1687 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern void ficlSystemCompileCore(ficlSystem *system);
+ extern void ficlSystemCompilePrefix(ficlSystem *system);
+ extern void ficlSystemCompileSearch(ficlSystem *system);
+ extern void ficlSystemCompileSoftCore(ficlSystem *system);
+ extern void ficlSystemCompileTools(ficlSystem *system);
+ extern void ficlSystemCompileFile(ficlSystem *system);
+
+ extern void ficlSystemCompileFloat(ficlSystem *system);
+ extern int ficlVmParseFloatNumber(ficlVm *vm, ficlString s);
+
+
+
+
+ extern void ficlSystemCompileExtras(ficlSystem *system);
+
+
+ extern int ficlVmParsePrefix(ficlVm *vm, ficlString s);
+
+
+ extern ficlWord *ficlSystemLookupLocal(ficlSystem *system, ficlString name);
+
+
+
+#line 1712 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern int ficlVmParseNumber(ficlVm *vm, ficlString s);
+ extern void ficlPrimitiveTick(ficlVm *vm);
+ extern void ficlPrimitiveParseStepParen(ficlVm *vm);
+
+ extern void ficlLocalParen(ficlVm *vm, int isDouble, int isFloat);
+
+
+
+
+#line 1727 "/usr/grobe0ba/projects/ficl/./ficl.h"
+ extern int ficlSystemAddParseStep(ficlSystem *system, ficlWord *word);
+ extern void ficlSystemAddPrimitiveParseStep(ficlSystem *system, char *name, ficlParseStep pStep);
+
+
+
+#line 1734 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+#line 1738 "/usr/grobe0ba/projects/ficl/./ficl.h"
+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,
+
+ FICL_WORDKIND_FLITERAL,
+
+ FICL_WORDKIND_LOOP,
+ FICL_WORDKIND_OF,
+ FICL_WORDKIND_PLOOP,
+ FICL_WORDKIND_PRIMITIVE,
+ FICL_WORDKIND_QDO,
+ FICL_WORDKIND_STRING_LITERAL,
+ FICL_WORDKIND_CSTRING_LITERAL,
+
+ FICL_WORDKIND_USER,
+
+ FICL_WORDKIND_VARIABLE,
+ FICL_WORDKIND_INSTRUCTION,
+ FICL_WORDKIND_INSTRUCTION_WORD,
+ FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT,
+} ficlWordKind;
+
+ficlWordKind ficlWordClassify(ficlWord *word);
+
+
+
+
+
+#line 1777 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+typedef struct ficlFile
+{+ FILE *f;
+ char filename[256];
+} ficlFile;
+
+
+
+ extern int ficlFileTruncate(ficlFile *ff, ficlUnsigned size);
+
+
+ extern int ficlFileStatus(char *filename, int *status);
+ extern long ficlFileSize(ficlFile *ff);
+
+
+
+#line 1804 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 1833 "/usr/grobe0ba/projects/ficl/./ficl.h"
+
+
+
+
+
+ extern int ficlBitGet(const unsigned char *bits, size_t index);
+ extern void ficlBitSet(unsigned char *bits, size_t size_t, int value);
+ extern void ficlBitGetString(unsigned char *destination, const unsigned char *source, int offset, int count, int destAlignment);
+
+ extern ficlUnsigned16 ficlNetworkUnsigned16(ficlUnsigned16 number);
+ extern ficlUnsigned32 ficlNetworkUnsigned32(ficlUnsigned32 number);
+
+
+ extern int ficlLzCompress(const char *uncompressed, size_t uncompressedSize, unsigned char **compressed, size_t *compressedSize);
+ extern int ficlLzUncompress(const unsigned char *compressed, char **uncompressed, size_t *uncompressedSize);
+
+
+
+
+
+
+
+
+
+
+
+
+
+#line 44 "/usr/grobe0ba/projects/ficl/main.c"
+
+
+int main(int argc, char **argv)
+{+ int returnValue = 0;
+ char buffer[256];
+ ficlVm *vm;
+ ficlSystem *system;
+
+ system = ficlSystemCreate(((void *)0));
+ ficlSystemCompileExtras(system);
+ vm = ficlSystemCreateVm(system);
+
+ returnValue = ficlVmEvaluate(vm, ".ver .( " "Jan 27 2021" " ) cr quit");
+
+
+#line 62 "/usr/grobe0ba/projects/ficl/main.c"
+ if (argc > 1)
+ {+ sprintf(buffer, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
+ returnValue = ficlVmEvaluate(vm, buffer);
+ }
+
+ while (returnValue !=(-259))
+ {+ fputs("ok> ",(& _IO_stream[1]));+ if (fgets(buffer, sizeof(buffer),(& _IO_stream[0])) ==((void *)0)) break;
+ returnValue = ficlVmEvaluate(vm, buffer);
+ }
+
+ ficlSystemDestroy(system);
+ return 0;
+}
+
--- /dev/null
+++ b/lzcompress.c
@@ -1,0 +1,200 @@
+#include <assert.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "ficl.h"
+
+
+static int ficlLzCompareWindow(const unsigned char *window, const unsigned char *buffer,
+ int *offset, unsigned char *next, int windowSize, int bufferSize)
+ {+ const unsigned char *windowEnd;
+ const unsigned char *bufferEnd;
+ int longest;
+ unsigned char bufferFirst;
+ const unsigned char *windowTrace;
+
+ longest = 0;
+ bufferFirst = buffer[0];
+ *next = bufferFirst;
+
+ /*
+ ** we can't match more than bufferSize-1 characters...
+ ** we need to reserve the last character for the "next",
+ ** and this also prevents us from returning FICL_LZ_BUFFER_LENGTH
+ ** as the length (which won't work, max we can store is FICL_LZ_BUFFER_LENGTH - 1)
+ */
+ bufferSize--;
+
+ windowEnd = window + windowSize;
+ bufferEnd = buffer + bufferSize;
+
+ for (windowTrace = window; windowTrace < windowEnd; windowTrace++)
+ {+ const unsigned char *bufferTrace;
+ const unsigned char *windowTrace2;
+ int length;
+
+ if (*windowTrace != bufferFirst)
+ continue;
+
+ bufferTrace = buffer;
+ for (windowTrace2 = windowTrace;
+ (windowTrace2 < windowEnd) && (bufferTrace < bufferEnd)
+ && (*windowTrace2 == *bufferTrace);
+ windowTrace2++, bufferTrace++)
+ {+ }
+
+ length = windowTrace2 - windowTrace;
+ if ((length > longest) && (length >= FICL_LZ_MINIMUM_USEFUL_MATCH))
+ {+ *offset = windowTrace - window;
+ longest = length;
+ *next = *bufferTrace;
+ }
+ }
+
+ return longest;
+ }
+
+
+
+void ficlLzEncodeHeaderField(unsigned char *data, unsigned int input, int *byteOffset)
+ {+ int i;
+
+ if (input <= 252)
+ data[(*byteOffset)++] = (unsigned char)input;
+ else
+ {+ unsigned char id;
+ int length;
+ int inputPosition;
+ int bitsOffset;
+
+ if (input <= 65536)
+ {+ id = 253;
+ length = 2;
+ }
+ else
+ {+ id = 254;
+ length = 4;
+ }
+
+ input = ficlNetworkUnsigned32(input);
+ inputPosition = (sizeof(uint32_t) * 8) - (length * 8);
+ bitsOffset;
+
+ data[(*byteOffset)++] = (unsigned char)id;
+ bitsOffset = *byteOffset * 8;
+ (*byteOffset) += length;
+
+ for (i = 0; i < (length * 8); i++)
+ ficlBitSet(data, bitsOffset++, ficlBitGet((unsigned char *)&input, inputPosition++));
+ }
+ }
+
+
+
+int ficlLzCompress(const char *uncompressed, size_t uncompressedSize, unsigned char **compressed_p, size_t *compressedSize_p)
+ {+ unsigned char *compressed;
+ const unsigned char *window;
+ const unsigned char *buffer;
+ int outputPosition;
+ int remaining;
+ int windowSize;
+ int headerLength;
+ unsigned char headerBuffer[10];
+ int compressedSize;
+ int totalSize;
+
+ *compressed_p = NULL;
+
+ compressed = (unsigned char *)calloc(((uncompressedSize * 5) / 4) + 10, 1);
+ if (compressed == NULL)
+ return -1;
+
+ window = buffer = (const unsigned char*)uncompressed;
+
+ outputPosition = 0;
+ remaining = uncompressedSize;
+ windowSize = 0;
+
+ while (remaining > 0)
+ {+ int bufferSize = FICL_MIN(remaining, FICL_LZ_BUFFER_SIZE);
+ int useWindowSize = FICL_MIN(remaining, windowSize);
+ int offset = 0;
+ int i;
+
+ unsigned long token;
+ int tokenLength;
+ unsigned char next;
+
+ int length = ficlLzCompareWindow(window, buffer, &offset, &next, useWindowSize, bufferSize);
+ if (length > 1)
+ {+ /* phrase token */
+ assert((length - FICL_LZ_MINIMUM_USEFUL_MATCH) < (1 << FICL_LZ_LENGTH_BITS));
+ token = (1 << (FICL_LZ_PHRASE_BITS - 1))
+ | (offset << (FICL_LZ_PHRASE_BITS - FICL_LZ_TYPE_BITS - FICL_LZ_OFFSET_BITS))
+ | ((length - FICL_LZ_MINIMUM_USEFUL_MATCH) << (FICL_LZ_PHRASE_BITS - FICL_LZ_TYPE_BITS - FICL_LZ_OFFSET_BITS - FICL_LZ_LENGTH_BITS))
+ | next;
+
+ tokenLength = FICL_LZ_PHRASE_BITS;
+ }
+ else
+ {+ token = next;
+ tokenLength = FICL_LZ_SYMBOL_BITS;
+ }
+
+ token = ficlNetworkUnsigned32(token);
+ for (i = 0; i < tokenLength; i++)
+ {+ int inputPosition = (sizeof(uint32_t) * 8) - tokenLength + i;
+ ficlBitSet(compressed, outputPosition, ficlBitGet((unsigned char *)&token, inputPosition));
+ outputPosition++;
+ }
+
+ length++;
+
+ buffer += length;
+ if (windowSize == FICL_LZ_WINDOW_SIZE)
+ window += length;
+ else
+ {+ if ((windowSize + length) < FICL_LZ_WINDOW_SIZE)
+ windowSize += length;
+ else
+ {+ window += (windowSize + length) - FICL_LZ_WINDOW_SIZE;
+ windowSize = FICL_LZ_WINDOW_SIZE;
+ }
+ }
+
+ remaining -= length;
+ }
+
+ headerLength = 0;
+ memset(&headerBuffer, 0, sizeof(headerBuffer));
+ ficlLzEncodeHeaderField(headerBuffer, outputPosition, &headerLength);
+ ficlLzEncodeHeaderField(headerBuffer, uncompressedSize, &headerLength);
+
+ /* plug in header */
+ compressedSize = (((outputPosition - 1) / 8) + 1);
+ totalSize = compressedSize + headerLength;
+ compressed = (unsigned char *)realloc(compressed, totalSize);
+ memmove(compressed + headerLength, compressed, compressedSize);
+ memcpy(compressed, headerBuffer, headerLength);
+
+ *compressed_p = compressed;
+ *compressedSize_p = totalSize;
+
+ return 0;
+ }
+
--- /dev/null
+++ b/lzuncompress.c
@@ -1,0 +1,94 @@
+#include <stdlib.h>
+#include <string.h>
+
+#include "ficl.h"
+
+
+
+int ficlLzDecodeHeaderField(const unsigned char *data, int *byteOffset)
+ {+ unsigned char id;
+ int networkOrder;
+ int length;
+
+ id = data[(*byteOffset)++];
+ if (id < 252)
+ return id;
+
+ networkOrder = 0;
+ length = (id == 253) ? 2: 4;
+
+ ficlBitGetString(((unsigned char *)&networkOrder), data,
+ (*byteOffset) * 8,
+ length * 8, sizeof(networkOrder) * 8);
+ (*byteOffset) += length;
+
+ return ficlNetworkUnsigned32(networkOrder);
+ }
+
+
+
+int ficlLzUncompress(const unsigned char *compressed, char **uncompressed_p, size_t *uncompressedSize_p)
+ {+ unsigned char *window;
+ unsigned char *buffer;
+ unsigned char *uncompressed;
+ unsigned char *initialWindow;
+
+ int bitstreamLength;
+ int inputPosition;
+ int uncompressedSize;
+
+ *uncompressed_p = NULL;
+
+ inputPosition = 0;
+ bitstreamLength = ficlLzDecodeHeaderField(compressed, &inputPosition);
+ uncompressedSize = ficlLzDecodeHeaderField(compressed, &inputPosition);
+
+ inputPosition <<= 3; /* same as * 8 */
+
+ bitstreamLength += inputPosition;
+
+ uncompressed = (unsigned char *)calloc(uncompressedSize + 1, 1);
+ if (uncompressed == NULL)
+ return -1;
+ window = buffer = uncompressed;
+ initialWindow = buffer + FICL_LZ_WINDOW_SIZE;
+
+ while (inputPosition != bitstreamLength)
+ {+ int length;
+ int token = ficlBitGet(compressed, inputPosition);
+ inputPosition++;
+
+ if (token)
+ {+ /* phrase token */
+ int offset = 0;
+ ficlBitGetString((unsigned char *)&offset, compressed, inputPosition, FICL_LZ_PHRASE_BITS - (1 + FICL_LZ_NEXT_BITS), sizeof(offset) * 8);
+ offset = ficlNetworkUnsigned32(offset);
+ inputPosition += FICL_LZ_PHRASE_BITS - (1 + FICL_LZ_NEXT_BITS);
+
+ length = (offset & ((1 << FICL_LZ_LENGTH_BITS) - 1)) + FICL_LZ_MINIMUM_USEFUL_MATCH;
+ offset >>= FICL_LZ_LENGTH_BITS;
+
+ memmove(buffer, window + offset, length);
+ buffer += length;
+ length++;
+ }
+ else
+ length = 1;
+
+ /* symbol token */
+ *buffer = 0;
+ ficlBitGetString(buffer++, compressed, inputPosition, FICL_LZ_NEXT_BITS, sizeof(*buffer) * 8);
+ inputPosition += FICL_LZ_NEXT_BITS;
+ if (buffer > initialWindow)
+ window = buffer - FICL_LZ_WINDOW_SIZE;
+ }
+
+ *uncompressed_p = (char *)uncompressed;
+ *uncompressedSize_p = uncompressedSize;
+
+ return 0;
+ }
--- /dev/null
+++ b/main.c
@@ -1,0 +1,78 @@
+/*
+** stub main for testing Ficl
+** $Id: main.c,v 1.3 2010/11/01 14:10:27 asau Exp $
+*/
+/*
+** Copyright (c) 1997-2001 John Sadler ([email protected])
+** 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 "ficl.h"
+
+
+int main(int argc, char **argv)
+{+ int returnValue = 0;
+ char buffer[256];
+ ficlVm *vm;
+ ficlSystem *system;
+
+ system = ficlSystemCreate(NULL);
+ ficlSystemCompileExtras(system);
+ vm = ficlSystemCreateVm(system);
+
+ returnValue = ficlVmEvaluate(vm, ".ver .( " __DATE__ " ) cr quit");
+
+ /*
+ ** load files specified on command-line
+ */
+ if (argc > 1)
+ {+ sprintf(buffer, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
+ returnValue = ficlVmEvaluate(vm, buffer);
+ }
+
+ while (returnValue != FICL_VM_STATUS_USER_EXIT)
+ {+ fputs(FICL_PROMPT, stdout);
+ if (fgets(buffer, sizeof(buffer), stdin) == NULL) break;
+ returnValue = ficlVmEvaluate(vm, buffer);
+ }
+
+ ficlSystemDestroy(system);
+ return 0;
+}
+
--- /dev/null
+++ b/mkfile
@@ -1,0 +1,14 @@
+none:VQ:
+ echo usage: mk all, install, clean
+
+all:V: lib bin
+
+bin:V: lib
+ mk -f mkfile.bin install
+
+lib:V:
+ mk -f mkfile.lib install
+
+clean:
+ mk -f mkfile.bin clean
+ mk -f mkfile.lib clean
--- /dev/null
+++ b/mkfile.bin
@@ -1,0 +1,23 @@
+</amd64/mkfile
+
+CFLAGS=-I. -D_POSIX_SOURCE -D_SUSV2_SOURCE
+CC=pcc
+
+BIN=ficl
+
+OFILES=\
+ main.$O
+
+all:V: $O.out
+
+install:V: $O.out
+ cp $O.out ficl
+
+$O.out: main.$O
+ $LD -o $target $OFILES libficl.a
+
+%.$O: %.c
+ pcc $CFLAGS -c -o $target $stem.c
+
+clean:V:
+ rm -f ficl main.$O
--- /dev/null
+++ b/mkfile.lib
@@ -1,0 +1,45 @@
+</amd64/mkfile
+
+CFLAGS=-I. -D_POSIX_SOURCE -D_SUSV2_SOURCE
+CC=pcc
+
+LIB=libficl.a
+
+OFILES=\
+ 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\
+ utility.$O\
+ hash.$O\
+ callback.$O\
+ word.$O\
+ extras.$O\
+ unix.$O
+
+HFILES=\
+ ficlplatform/unix.h
+
+CLEANFILES=libficl.a
+
+</sys/src/cmd/mklib
+
+%.$O: %.c
+ pcc $CFLAGS -c -o $target $stem.c
+
+softcore.$O:
+ cd softcore && mk && cd ..
+ $CC $CFLAGS -c -o softcore.$O softcore/softcore.c
+
+unix.$O:
+ $CC $CFLAGS -Ificlplatform -c -o unix.$O ficlplatform/unix.c
--- /dev/null
+++ b/prefix.c
@@ -1,0 +1,178 @@
+/*******************************************************************
+** p r e f i x . c
+** Forth Inspired Command Language
+** Parser extensions for Ficl
+** Authors: Larry Hastings & John Sadler ([email protected])
+** Created: April 2001
+** $Id: prefix.c,v 1.9 2010/11/01 14:10:27 asau Exp $
+*******************************************************************/
+/*
+** Copyright (c) 1997-2001 John Sadler ([email protected])
+** 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 <ctype.h>
+#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;
+ return;
+}
+
+
+
+/**************************************************************************
+ 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!
+ */
+
+ return;
+}
--- /dev/null
+++ b/primitives.c
@@ -1,0 +1,3520 @@
+/*******************************************************************
+** w o r d s . c
+** Forth Inspired Command Language
+** ANS Forth CORE word-set written in C
+** Author: John Sadler ([email protected])
+** Created: 19 July 1997
+** $Id: primitives.c,v 1.7 2010/12/02 13:56:43 asau Exp $
+*******************************************************************/
+/*
+** Copyright (c) 1997-2001 John Sadler ([email protected])
+** 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 <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include "ficl.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);
+ return;
+}
+
+static void markControlTag(ficlVm *vm, char *tag)
+{+ ficlStackPushPointer(vm->dataStack, tag);
+ return;
+}
+
+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);
+ }
+
+ return;
+}
+
+/*
+** 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)
+{+ ficlInteger offset;
+ ficlCell *patchAddr;
+
+ matchControlTag(vm, tag);
+
+ FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+ patchAddr = (ficlCell *)ficlStackPopPointer(vm->dataStack);
+ offset = patchAddr - dictionary->here;
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(offset));
+
+ return;
+}
+
+
+/*
+** 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 = FICL_LVALUE_TO_CELL(offset);
+
+ return;
+}
+
+/*
+** 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 = (char *)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 = FICL_LVALUE_TO_CELL(dictionary->here);
+
+ return;
+}
+
+
+/**************************************************************************
+ c o l o n d e f i n i t i o n s
+** Code to begin compiling a colon definition
+** This function sets the state to 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
+ return;
+}
+
+
+
+static void ficlPrimitiveSemicolonCoIm(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+ matchControlTag(vm, colonTag);
+
+#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
+
+ ficlDictionaryAppendUnsigned(dictionary, ficlInstructionSemiParen);
+ vm->state = FICL_VM_STATE_INTERPRET;
+ ficlDictionaryUnsmudge(dictionary);
+ return;
+}
+
+
+/**************************************************************************
+ e x i t
+** CORE
+** This function simply pops the previous instruction
+** pointer and returns to the "next" loop. Used for exiting from within
+** a definition. Note that exitParen is identical to semiParen - they
+** are in two different functions so that "see" can correctly identify
+** the end of a colon definition, even if it uses "exit".
+**************************************************************************/
+
+static void 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);
+ return;
+}
+
+
+/**************************************************************************
+ c o n s t a n t
+** IMMEDIATE
+** Compiles a constant into the dictionary. Constants return their
+** value when invoked. Expects a value on top of the parm stack.
+**************************************************************************/
+
+static void 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));
+ return;
+}
+
+
+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));
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+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);
+ return;
+}
+
+
+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);
+ return;
+}
+
+
+/**************************************************************************
+ 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 = 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, append && FICL_TRUE);
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ e m i t & f r i e n d s
+**
+**************************************************************************/
+
+static void ficlPrimitiveEmit(ficlVm *vm)
+{+ char *buffer = vm->pad;
+ int i;
+
+
+ FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+ i = ficlStackPopInteger(vm->dataStack);
+ buffer[0] = (char)i;
+ buffer[1] = '\0';
+ ficlVmTextOut(vm, buffer);
+ return;
+}
+
+
+static void ficlPrimitiveCR(ficlVm *vm)
+{+ ficlVmTextOut(vm, "\n");
+ return;
+}
+
+
+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);
+ return;
+}
+
+
+/*
+** paren CORE
+** Compilation: Perform the execution semantics given below.
+** Execution: ( "ccc<paren>" -- )
+** Parse ccc delimited by ) (right parenthesis). ( is an immediate word.
+** The number of characters in ccc may be zero to the number of characters
+** in the parse area.
+**
+*/
+static void ficlPrimitiveParenthesis(ficlVm *vm)
+{+ ficlVmParseStringEx(vm, ')', 0);
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+
+
+/**************************************************************************
+ 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);
+ patchAddr =
+ (ficlCell *)ficlStackPopPointer(vm->dataStack); /* (2) pop "if" patch addr */
+ markBranch(dictionary, vm, origTag); /* (4) push "else" patch addr */
+ ficlDictionaryAppendUnsigned(dictionary, 1); /* (1) FICL_VM_STATE_COMPILE patch placeholder */
+ offset = dictionary->here - patchAddr;
+ *patchAddr = FICL_LVALUE_TO_CELL(offset); /* (3) Patch "if" */
+
+ return;
+}
+
+
+/**************************************************************************
+ e n d i f C o I m
+**
+**************************************************************************/
+
+static void ficlPrimitiveEndifCoIm(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+ resolveForwardBranch(dictionary, vm, origTag);
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ 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 = (ficlCell *)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 = FICL_LVALUE_TO_CELL(offset);
+ }
+ return;
+}
+
+
+/**************************************************************************
+ 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 = (ficlCell *)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 = FICL_LVALUE_TO_CELL(offset);
+ }
+
+ return;
+}
+
+
+/**************************************************************************
+ 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 = FICL_LVALUE_TO_CELL(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 = FICL_LVALUE_TO_CELL(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));
+ return;
+}
+
+/**************************************************************************
+** Report error
+**************************************************************************/
+static void ficlVmThrowNotFound(ficlVm *vm, ficlString s)
+{+ ficlVmThrowError(vm, "%.*s not found", FICL_STRING_GET_LENGTH(s), FICL_STRING_GET_POINTER(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;
+ }
+ }
+
+ ficlVmThrowNotFound(vm, s);
+
+ return; /* 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));
+ return;
+}
+
+
+/**************************************************************************
+ 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));
+
+ return;
+}
+
+
+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);
+ return;
+}
+
+
+
+/**************************************************************************
+ l i t e r a l I m
+**
+** IMMEDIATE code for "literal". This function gets a value from the stack
+** and compiles it into the dictionary preceded by the code for "(literal)".
+** IMMEDIATE
+**************************************************************************/
+
+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;
+ }
+
+ return;
+}
+
+
+static void ficlPrimitive2LiteralIm(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+ ficlDictionaryAppendUnsigned(dictionary, ficlInstruction2LiteralParen);
+ ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->dataStack));
+ ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->dataStack));
+
+ return;
+}
+
+/**************************************************************************
+ 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);
+
+ return;
+}
+
+
+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);
+
+ return;
+}
+
+
+static void ficlPrimitiveLoopCoIm(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+ ficlDictionaryAppendUnsigned(dictionary, ficlInstructionLoopParen);
+ resolveBackBranch(dictionary, vm, doTag);
+ resolveAbsBranch(dictionary, vm, leaveTag);
+ return;
+}
+
+
+static void ficlPrimitivePlusLoopCoIm(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+ ficlDictionaryAppendUnsigned(dictionary, ficlInstructionPlusLoopParen);
+ resolveBackBranch(dictionary, vm, doTag);
+ resolveAbsBranch(dictionary, vm, leaveTag);
+ return;
+}
+
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+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);
+ return;
+}
+
+
+/**************************************************************************
+ b a s e & f r i e n d s
+**
+**************************************************************************/
+
+static void ficlPrimitiveBase(ficlVm *vm)
+{+ ficlCell *pBase;
+
+ FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+ pBase = (ficlCell *)(&vm->base);
+ ficlStackPush(vm->dataStack, FICL_LVALUE_TO_CELL(pBase));
+ return;
+}
+
+
+static void ficlPrimitiveDecimal(ficlVm *vm)
+{+ vm->base = 10;
+ return;
+}
+
+
+static void ficlPrimitiveHex(ficlVm *vm)
+{+ vm->base = 16;
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+static void ficlPrimitiveHere(ficlVm *vm)
+{+ ficlDictionary *dictionary;
+
+ FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+ dictionary = ficlVmGetDictionary(vm);
+ ficlStackPushPointer(vm->dataStack, dictionary->here);
+ return;
+}
+
+
+
+
+/**************************************************************************
+ t i c k
+** tick CORE ( "<spaces>name" -- xt )
+** Skip leading space delimiters. Parse name delimited by a space. Find
+** name and return xt, the execution token for name. An ambiguous condition
+** exists if name is not found.
+**************************************************************************/
+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)
+ ficlVmThrowNotFound(vm, name);
+ ficlStackPushPointer(vm->dataStack, word);
+ return;
+}
+
+
+static void ficlPrimitiveBracketTickCoIm(ficlVm *vm)
+{+ ficlPrimitiveTick(vm);
+ ficlPrimitiveLiteralIm(vm);
+
+ return;
+}
+
+
+/**************************************************************************
+ 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, ",");
+ FICL_VM_ASSERT(vm, pComma);
+
+ ficlPrimitiveTick(vm);
+ word = (ficlWord *)ficlStackGetTop(vm->dataStack).p;
+ if (ficlWordIsImmediate(word))
+ {+ ficlDictionaryAppendCell(dictionary, ficlStackPop(vm->dataStack));
+ }
+ else
+ {+ ficlPrimitiveLiteralIm(vm);
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(pComma));
+ }
+
+ return;
+}
+
+
+
+/**************************************************************************
+ e x e c u t e
+** Pop an execution token (pointer to a word) off the stack and
+** run it
+**************************************************************************/
+
+static void ficlPrimitiveExecute(ficlVm *vm)
+{+ ficlWord *word;
+
+ FICL_STACK_CHECK(vm->dataStack, 1, 0);
+
+ word = (ficlWord *)ficlStackPopPointer(vm->dataStack);
+ ficlVmExecuteWord(vm, word);
+
+ return;
+}
+
+
+/**************************************************************************
+ 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));
+ return;
+}
+
+
+static void ficlPrimitiveCompileOnly(ficlVm *vm)
+{+ FICL_IGNORE(vm);
+ ficlDictionarySetFlags(ficlVmGetDictionary(vm), FICL_WORD_COMPILE_ONLY);
+ return;
+}
+
+
+static void ficlPrimitiveSetObjectFlag(ficlVm *vm)
+{+ FICL_IGNORE(vm);
+ ficlDictionarySetFlags(ficlVmGetDictionary(vm), FICL_WORD_OBJECT);
+ return;
+}
+
+static void ficlPrimitiveIsObject(ficlVm *vm)
+{+ int flag;
+ ficlWord *word = (ficlWord *)ficlStackPopPointer(vm->dataStack);
+
+ flag = ((word != NULL) && (word->flags & FICL_WORD_OBJECT)) ? FICL_TRUE : FICL_FALSE;
+ ficlStackPushInteger(vm->dataStack, flag);
+ return;
+}
+
+
+
+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);
+ }
+
+ return;
+}
+
+/**************************************************************************
+ 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");
+ FICL_VM_ASSERT(vm, pType);
+ ficlDictionaryAppendUnsigned(dictionary, ficlInstructionStringLiteralParen);
+ dictionary->here = FICL_POINTER_TO_CELL(ficlVmGetString(vm, (ficlCountedString *)dictionary->here, '\"'));
+ ficlDictionaryAlign(dictionary);
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(pType));
+ return;
+}
+
+
+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);
+
+ return;
+}
+
+
+/**************************************************************************
+ s l i t e r a l
+** STRING
+** Interpretation: Interpretation semantics for this word are undefined.
+** Compilation: ( c-addr1 u -- )
+** Append the run-time semantics given below to the current definition.
+** Run-time: ( -- c-addr2 u )
+** Return c-addr2 u describing a string consisting of the characters
+** specified by c-addr1 u during compilation. A program shall not alter
+** the returned string.
+**************************************************************************/
+static void 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 = (char *)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));
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ c r e a t e . . . d o e s >
+** Make a new word in the dictionary with the run-time effect of
+** a variable (push my address), but with extra space allotted
+** for use by does> .
+**************************************************************************/
+
+
+static void ficlPrimitiveCreate(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+ ficlString name = ficlVmGetWord(vm);
+
+ ficlDictionaryAppendWord(dictionary, name, (ficlPrimitive)ficlInstructionCreateParen, FICL_WORD_DEFAULT);
+ ficlVmDictionaryAllotCells(vm, dictionary, 1);
+ return;
+}
+
+
+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);
+ return;
+}
+
+
+/**************************************************************************
+ t o b o d y
+** to-body CORE ( xt -- a-addr )
+** a-addr is the data-field address corresponding to xt. An ambiguous
+** condition exists if xt is not for a word defined via CREATE.
+**************************************************************************/
+static void ficlPrimitiveToBody(ficlVm *vm)
+{+ ficlWord *word;
+ FICL_STACK_CHECK(vm->dataStack, 1, 1);
+
+ word = (ficlWord *)ficlStackPopPointer(vm->dataStack);
+ ficlStackPushPointer(vm->dataStack, word->param + 1);
+ return;
+}
+
+
+/*
+** 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);
+ return;
+}
+
+
+/*
+** >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 = (ficlWord *)ficlStackPopPointer(vm->dataStack);
+ ficlStackPushPointer(vm->dataStack, word->name);
+ ficlStackPushUnsigned(vm->dataStack, word->length);
+ return;
+}
+
+
+static void ficlPrimitiveLastWord(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+ ficlWord *wp = dictionary->smudge;
+ FICL_VM_ASSERT(vm, wp);
+ ficlVmPush(vm, FICL_LVALUE_TO_CELL(wp));
+ return;
+}
+
+
+/**************************************************************************
+ l b r a c k e t e t c
+**
+**************************************************************************/
+
+static void ficlPrimitiveLeftBracketCoIm(ficlVm *vm)
+{+ vm->state = FICL_VM_STATE_INTERPRET;
+ return;
+}
+
+
+static void ficlPrimitiveRightBracket(ficlVm *vm)
+{+ vm->state = FICL_VM_STATE_COMPILE;
+ return;
+}
+
+
+/**************************************************************************
+ p i c t u r e d n u m e r i c w o r d s
+**
+** less-number-sign CORE ( -- )
+** Initialize the pictured numeric output conversion process.
+** (clear the pad)
+**************************************************************************/
+static void ficlPrimitiveLessNumberSign(ficlVm *vm)
+{+ ficlCountedString *counted = FICL_POINTER_TO_COUNTED_STRING(vm->pad);
+ counted->length = 0;
+ return;
+}
+
+/*
+** number-sign CORE ( ud1 -- ud2 )
+** Divide ud1 by the number in BASE giving the quotient ud2 and the remainder
+** n. (n is the least-significant digit of ud1.) Convert n to external form
+** and add the resulting character to the beginning of the pictured numeric
+** output string. An ambiguous condition exists if # executes outside of a
+** <# #> delimited number conversion.
+*/
+static void 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);
+ return;
+}
+
+/*
+** number-sign-greater CORE ( xd -- c-addr u )
+** Drop xd. Make the pictured numeric output string available as a character
+** string. c-addr and u specify the resulting character string. A program
+** may replace characters within the string.
+*/
+static void 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);
+ return;
+}
+
+/*
+** number-sign-s CORE ( ud1 -- ud2 )
+** Convert one digit of ud1 according to the rule for #. Continue conversion
+** until the quotient is zero. ud2 is zero. An ambiguous condition exists if
+** #S executes outside of a <# #> delimited number conversion.
+** TO DO: presently does not use ud1 hi 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);
+ return;
+}
+
+/*
+** HOLD CORE ( char -- )
+** Add char to the beginning of the pictured numeric output string. An ambiguous
+** condition exists if HOLD executes outside of a <# #> delimited number conversion.
+*/
+static void 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;
+ return;
+}
+
+/*
+** SIGN CORE ( n -- )
+** If n is negative, add a minus sign to the beginning of the pictured
+** numeric output string. An ambiguous condition exists if SIGN
+** executes outside of a <# #> delimited number conversion.
+*/
+static void 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++] = '-';
+ return;
+}
+
+
+/**************************************************************************
+ t o N u m b e r
+** to-number CORE ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 )
+** ud2 is the unsigned result of converting the characters within the
+** string specified by c-addr1 u1 into digits, using the number in BASE,
+** and adding each into ud1 after multiplying ud1 by the number in BASE.
+** Conversion continues left-to-right until a character that is not
+** convertible, including any + or -, is encountered or the string is
+** entirely converted. c-addr2 is the location of the first unconverted
+** character or the first character past the end of the string if the string
+** was entirely converted. u2 is the number of unconverted characters in the
+** string. An ambiguous condition exists if ud2 overflows during the
+** conversion.
+**************************************************************************/
+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);
+
+ return;
+}
+
+
+
+/**************************************************************************
+ q u i t & a b o r t
+** quit CORE ( -- ) ( R: i*x -- )
+** Empty the return stack, store zero in SOURCE-ID if it is present, make
+** the user input device the input source, and enter interpretation state.
+** Do not display a message. Repeat the following:
+**
+** Accept a line from the input source into the input buffer, set >IN to
+** zero, and 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);
+ return;
+}
+
+
+static void ficlPrimitiveAbort(ficlVm *vm)
+{+ ficlVmThrow(vm, FICL_VM_STATUS_ABORT);
+ return;
+}
+
+
+/**************************************************************************
+ a c c e p t
+** accept CORE ( c-addr +n1 -- +n2 )
+** Receive a string of at most +n1 characters. An ambiguous condition
+** exists if +n1 is zero or greater than 32,767. Display graphic characters
+** as they are received. A program that depends on the presence or absence
+** of non-graphic characters in the string has an environmental dependency.
+** The editing functions, if any, that the system performs in order to
+** construct the string are implementation-defined.
+**
+** (Although the standard text doesn't say so, I assume that the intent
+** of 'accept' is to store the string at the address specified on
+** the stack.)
+** Implementation: if there's more text in the TIB, use it. Otherwise
+** throw out for more text. Copy characters up to the max count into the
+** address given, and return the number of actual characters copied.
+**
+** Note (sobral) this may not be the behavior you'd expect if you're
+** trying to get user input at load time!
+**************************************************************************/
+static void ficlPrimitiveAccept(ficlVm *vm)
+{+ ficlUnsigned size;
+ char *address;
+
+ ficlUnsigned length;
+ char *trace;
+ char *end;
+
+ FICL_STACK_CHECK(vm->dataStack, 2, 1);
+
+ trace = ficlVmGetInBuf(vm);
+ end = ficlVmGetInBufEnd(vm);
+ length = end - trace;
+ if (length == 0)
+ ficlVmThrow(vm, FICL_VM_STATUS_RESTART);
+
+ /*
+ ** Now we have something in the text buffer - use it
+ */
+ size = ficlStackPopInteger(vm->dataStack);
+ address = (char *)ficlStackPopPointer(vm->dataStack);
+
+ length = (size < length) ? size : length;
+ strncpy(address, trace, length);
+ trace += length;
+ ficlVmUpdateTib(vm, trace);
+ ficlStackPushInteger(vm->dataStack, length);
+
+ return;
+}
+
+
+/**************************************************************************
+ a l i g n
+** 6.1.0705 ALIGN CORE ( -- )
+** If the data-space pointer is not aligned, reserve enough space to
+** align it.
+**************************************************************************/
+static void ficlPrimitiveAlign(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+ FICL_IGNORE(vm);
+ ficlDictionaryAlign(dictionary);
+ return;
+}
+
+
+/**************************************************************************
+ 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));
+ return;
+}
+
+
+/**************************************************************************
+ b e g i n & f r i e n d s
+** Indefinite loop control structures
+** A.6.1.0760 BEGIN
+** Typical use:
+** : X ... BEGIN ... test UNTIL ;
+** or
+** : X ... BEGIN ... test WHILE ... REPEAT ;
+**************************************************************************/
+static void ficlPrimitiveBeginCoIm(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+ markBranch(dictionary, vm, destTag);
+ return;
+}
+
+static void ficlPrimitiveUntilCoIm(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+ ficlDictionaryAppendUnsigned(dictionary, ficlInstructionBranch0ParenWithCheck);
+ resolveBackBranch(dictionary, vm, destTag);
+ return;
+}
+
+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);
+ return;
+}
+
+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);
+ return;
+}
+
+
+static void ficlPrimitiveAgainCoIm(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+ ficlDictionaryAppendUnsigned(dictionary, ficlInstructionBranchParenWithCheck);
+ /* expect "begin" branch marker */
+ resolveBackBranch(dictionary, vm, destTag);
+ return;
+}
+
+
+/**************************************************************************
+ c h a r & f r i e n d s
+** 6.1.0895 CHAR CORE ( "<spaces>name" -- char )
+** Skip leading space delimiters. Parse name delimited by a space.
+** Put the value of its first character onto the stack.
+**
+** bracket-char CORE
+** Interpretation: Interpretation semantics for this word are undefined.
+** Compilation: ( "<spaces>name" -- )
+** Skip leading space delimiters. Parse name delimited by a space.
+** Append the run-time semantics given below to the current definition.
+** Run-time: ( -- char )
+** Place char, the value of the first character of name, on the stack.
+**************************************************************************/
+static void ficlPrimitiveChar(ficlVm *vm)
+{+ ficlString s;
+
+ FICL_STACK_CHECK(vm->dataStack, 0, 1);
+
+ s = ficlVmGetWord(vm);
+ ficlStackPushUnsigned(vm->dataStack, (ficlUnsigned)(s.text[0]));
+ return;
+}
+
+static void ficlPrimitiveCharCoIm(ficlVm *vm)
+{+ ficlPrimitiveChar(vm);
+ ficlPrimitiveLiteralIm(vm);
+ return;
+}
+
+/**************************************************************************
+ c h a r P l u s
+** char-plus CORE ( c-addr1 -- c-addr2 )
+** Add the size in address units of a character to c-addr1, giving c-addr2.
+**************************************************************************/
+static void ficlPrimitiveCharPlus(ficlVm *vm)
+{+ char *p;
+
+ FICL_STACK_CHECK(vm->dataStack,1,1);
+
+
+ p = (char *)ficlStackPopPointer(vm->dataStack);
+ ficlStackPushPointer(vm->dataStack, p + 1);
+ return;
+}
+
+/**************************************************************************
+ c h a r s
+** chars CORE ( n1 -- n2 )
+** n2 is the size in address units of n1 characters.
+** For most processors, this function can be a no-op. To guarantee
+** portability, we'll multiply by sizeof (char).
+**************************************************************************/
+#if defined (_M_IX86)
+#pragma warning(disable: 4127)
+#endif
+static void 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! */
+ return;
+}
+#if defined (_M_IX86)
+#pragma warning(default: 4127)
+#endif
+
+
+/**************************************************************************
+ c o u n t
+** COUNT CORE ( c-addr1 -- c-addr2 u )
+** Return the character string specification for the counted string stored
+** at c-addr1. c-addr2 is the address of the first character after c-addr1.
+** u is the contents of the character at c-addr1, which is the length in
+** characters of the string at c-addr2.
+**************************************************************************/
+static void ficlPrimitiveCount(ficlVm *vm)
+{+ ficlCountedString *counted;
+
+ FICL_STACK_CHECK(vm->dataStack,1,2);
+
+
+ counted = (ficlCountedString *)ficlStackPopPointer(vm->dataStack);
+ ficlStackPushPointer(vm->dataStack, counted->text);
+ ficlStackPushUnsigned(vm->dataStack, counted->length);
+ return;
+}
+
+/**************************************************************************
+ 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 = (char *)ficlStackPopPointer(vm->dataStack);
+
+ word = ficlDictionaryLookup(environment, name);
+
+ if (word != NULL)
+ {+ ficlVmExecuteWord(vm, word);
+ ficlStackPushInteger(vm->dataStack, FICL_TRUE);
+ }
+ else
+ {+ ficlStackPushInteger(vm->dataStack, FICL_FALSE);
+ }
+ return;
+}
+
+/**************************************************************************
+ e v a l u a t e
+** EVALUATE CORE ( i*x c-addr u -- j*x )
+** Save the current input source specification. Store minus-one (-1) in
+** SOURCE-ID if it is present. Make the string described by c-addr and u
+** both the input source and input buffer, set >IN to zero, and 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);
+
+ return;
+}
+
+
+/**************************************************************************
+ 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 = (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);
+ }
+
+ return;
+}
+
+
+/**************************************************************************
+ 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 = (char *)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);
+ return;
+}
+
+/**************************************************************************
+ w o r d
+** word CORE ( char "<chars>ccc<char>" -- c-addr )
+** Skip leading delimiters. Parse characters ccc delimited by char. An
+** ambiguous condition exists if the length of the parsed string is greater
+** than the implementation-defined length of a counted string.
+**
+** c-addr is the address of a transient region containing the parsed word
+** as a counted string. If the parse area was empty or contained no
+** characters other than the delimiter, the resulting string has a zero
+** length. A space, not included in the length, follows the string. A
+** program may replace characters within the string.
+** NOTE! Ficl also NULL-terminates the dest string.
+**************************************************************************/
+static void 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);
+ return;
+}
+
+
+/**************************************************************************
+ p a r s e - w o r d
+** Ficl PARSE-WORD ( <spaces>name -- c-addr u )
+** Skip leading spaces and parse name delimited by a space. c-addr is the
+** address within the input buffer and u is the length of the selected
+** string. If the parse area is empty, the resulting string has a zero length.
+**************************************************************************/
+static void 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));
+ return;
+}
+
+
+/**************************************************************************
+ p a r s e
+** CORE EXT ( char "ccc<char>" -- c-addr u )
+** Parse ccc delimited by the delimiter char.
+** c-addr is the address (within the input buffer) and u is the length of
+** the parsed string. If the parse area was empty, the resulting string has
+** a zero length.
+** NOTE! PARSE differs from WORD: it does not skip leading delimiters.
+**************************************************************************/
+static void 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));
+ return;
+}
+
+
+/**************************************************************************
+ f i n d
+** FIND CORE ( c-addr -- c-addr 0 | xt 1 | xt -1 )
+** Find the definition named in the counted string at c-addr. If the
+** definition is not found, return c-addr and zero. If the definition is
+** found, return its execution token xt. If the definition is immediate,
+** also return one (1), otherwise also return minus-one (-1). For a given
+** string, the values returned by FIND while compiling may differ from
+** those returned while not compiling.
+**************************************************************************/
+static void 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);
+ }
+ return;
+}
+
+
+
+/**************************************************************************
+ f i n d
+** FIND CORE ( c-addr -- c-addr 0 | xt 1 | xt -1 )
+** Find the definition named in the counted string at c-addr. If the
+** definition is not found, return c-addr and zero. If the definition is
+** found, return its execution token xt. If the definition is immediate,
+** also return one (1), otherwise also return minus-one (-1). For a given
+** string, the values returned by FIND while compiling may differ from
+** those returned while not compiling.
+**************************************************************************/
+static void ficlPrimitiveCFind(ficlVm *vm)
+{+ ficlCountedString *counted;
+ ficlString name;
+
+
+ FICL_STACK_CHECK(vm->dataStack, 1, 2);
+
+ counted = (ficlCountedString *)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 = (char *)ficlStackPopPointer(vm->dataStack);
+
+ do_find(vm, name, NULL);
+}
+
+
+
+/**************************************************************************
+ r e c u r s e
+**
+**************************************************************************/
+static void ficlPrimitiveRecurseCoIm(ficlVm *vm)
+{+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+
+ FICL_IGNORE(vm);
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(dictionary->smudge));
+ return;
+}
+
+
+/**************************************************************************
+ s o u r c e
+** CORE ( -- c-addr u )
+** c-addr is the address of, and u is the number of characters in, the
+** input buffer.
+**************************************************************************/
+static void ficlPrimitiveSource(ficlVm *vm)
+{+
+ FICL_STACK_CHECK(vm->dataStack,0,2);
+
+ ficlStackPushPointer(vm->dataStack, vm->tib.text);
+ ficlStackPushInteger(vm->dataStack, ficlVmGetInBufLen(vm));
+ return;
+}
+
+
+/**************************************************************************
+ v e r s i o n
+** non-standard...
+**************************************************************************/
+static void ficlPrimitiveVersion(ficlVm *vm)
+{+ ficlVmTextOut(vm, "Ficl version " FICL_VERSION "\n");
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ c o l o n N o N a m e
+** CORE EXT ( C: -- colon-sys ) ( S: -- xt )
+** Create an unnamed colon definition and push its address.
+** Change state to 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);
+ return;
+}
+
+
+/**************************************************************************
+ u s e r V a r i a b l e
+** user ( u -- ) "<spaces>name"
+** Get a name from the input stream and create a user variable
+** with the name and the index supplied. The run-time effect
+** of a user variable is to push the address of the indexed 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);
+ return;
+}
+#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)
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(nLocal));
+ }
+ return;
+}
+
+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 = 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);
+ ficlDictionaryAppendCell(locals, FICL_LVALUE_TO_CELL(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;
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(vm->callback.system->localsCount));
+ }
+
+ ficlDictionaryAppendUnsigned(dictionary, instruction);
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(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;
+ }
+
+ return;
+}
+
+
+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)
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(nLocal));
+ return;
+ }
+#endif
+
+#if FICL_WANT_LOCALS
+TO_GLOBAL:
+#endif /* FICL_WANT_LOCALS */
+ word = ficlDictionaryLookup(dictionary, name);
+ if (!word)
+ ficlVmThrowNotFound(vm, 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);
+ }
+ return;
+}
+
+
+/**************************************************************************
+ f m S l a s h M o d
+** f-m-slash-mod CORE ( d1 n1 -- n2 n3 )
+** Divide d1 by n1, giving the floored quotient n3 and the remainder n2.
+** Input and output stack arguments are signed. An ambiguous condition
+** exists if n1 is zero or if the quotient lies outside the range of a
+** single-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));
+ return;
+}
+
+
+/**************************************************************************
+ 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));
+ return;
+}
+
+
+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);
+ return;
+}
+
+
+/**************************************************************************
+ u m S l a s h M o d
+** u-m-slash-mod CORE ( ud u1 -- u2 u3 )
+** Divide ud by u1, giving the quotient u3 and the remainder u2.
+** All values and arithmetic are unsigned. An ambiguous condition
+** exists if u1 is zero or if the quotient lies outside the range of a
+** single-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));
+ return;
+}
+
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+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);
+ return;
+}
+
+
+/**************************************************************************
+ d n e g a t e
+** DOUBLE ( d1 -- d2 )
+** d2 is the negation of d1.
+**************************************************************************/
+static void ficlPrimitiveDNegate(ficlVm *vm)
+{+ ficl2Integer i = ficlStackPop2Integer(vm->dataStack);
+ i = ficl2IntegerNegate(i);
+ ficlStackPush2Integer(vm->dataStack, i);
+
+ return;
+}
+
+
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ 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 = (ficlWord *)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:
+ ficlVmPushIP(vm, &(vm->callback.system->exitInnerWord)); /* Open mouth, insert emetic */
+ 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 */
+ vm->exceptionHandler = vmCopy.exceptionHandler; /* Restore just the setjmp vector */
+ ficlStackPushInteger(vm->dataStack, 0); /* Push 0 -- everything is ok */
+ 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)
+ 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);
+ return;
+}
+
+
+#endif
+/**************************************************************************
+ f i c l C o m p i l e C o r e
+** Builds the primitive wordset and the environment-query namespace.
+**************************************************************************/
+
+void 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" */
+ 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", 0x7fffffff);
+ ficlDictionarySetConstant(environment, "max-u", 0xffffffff);
+ {+ ficl2Unsigned combined;
+ FICL_2UNSIGNED_SET(INT_MAX, UINT_MAX, combined);
+ ficlDictionarySet2Constant(environment,"max-d", FICL_2UNSIGNED_TO_2INTEGER(combined));
+ FICL_2UNSIGNED_SET(UINT_MAX, UINT_MAX, combined);
+ ficlDictionarySet2Constant(environment,"max-ud", FICL_2UNSIGNED_TO_2INTEGER(combined));
+ }
+ 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, "2value", ficlPrimitive2Constant, FICL_WORD_IMMEDIATE);
+ ficlDictionarySetPrimitive(dictionary, "2literal", ficlPrimitive2LiteralIm, FICL_WORD_IMMEDIATE);
+ ficlDictionarySetPrimitive(dictionary, "2variable", ficlPrimitive2Variable, FICL_WORD_IMMEDIATE);
+ ficlDictionarySetPrimitive(dictionary, "dnegate", ficlPrimitiveDNegate, FICL_WORD_DEFAULT);
+
+
+ /*
+ ** 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] = (ficlInstruction)interpret;
+ system->interpreterLoop[1] = (ficlInstruction)ficlInstructionBranchParen;
+ system->interpreterLoop[2] = (ficlInstruction)(void *)(-2);
+
+ FICL_SYSTEM_ASSERT(system, ficlDictionaryCellsAvailable(dictionary) > 0);
+
+ return;
+}
+
--- /dev/null
+++ b/search.c
@@ -1,0 +1,399 @@
+/*******************************************************************
+** 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 ([email protected])
+** Created: 6 June 2000
+** $Id: search.c,v 1.12 2010/12/02 13:56:43 asau Exp $
+*******************************************************************/
+/*
+** Copyright (c) 1997-2001 John Sadler ([email protected])
+** 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];
+ return;
+}
+
+
+/**************************************************************************
+ f o r t h - w o r d l i s t
+** SEARCH ( -- wid )
+** Return wid, the identifier of the word list that includes all standard
+** words provided by the implementation. This word list is initially the
+** compilation word list and is part of the initial search order.
+**************************************************************************/
+static void ficlPrimitiveForthWordlist(ficlVm *vm)
+{+ ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist;
+ ficlStackPushPointer(vm->dataStack, hash);
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ g e t - o r d e r
+** SEARCH ( -- widn ... wid1 n )
+** Returns the number of word lists n in the search order and the word list
+** identifiers widn ... wid1 identifying these word lists. wid1 identifies
+** the word list that is searched first, and widn the word list that is
+** searched last. The search order is unaffected.
+**************************************************************************/
+static void 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);
+ return;
+}
+
+
+/**************************************************************************
+ s e a r c h - w o r d l i s t
+** SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 )
+** Find the definition identified by the string c-addr u in the word list
+** identified by wid. If the definition is not found, return zero. If the
+** definition is found, return its execution token xt and one (1) if the
+** definition is immediate, minus-one (-1) otherwise.
+**************************************************************************/
+static void ficlPrimitiveSearchWordlist(ficlVm *vm)
+{+ ficlString name;
+ ficlUnsigned16 hashCode;
+ ficlWord *word;
+ ficlHash *hash = (ficlHash*)ficlStackPopPointer(vm->dataStack);
+
+ name.length = (ficlUnsigned8)ficlStackPopUnsigned(vm->dataStack);
+ name.text = (char*)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);
+ }
+
+ return;
+}
+
+
+/**************************************************************************
+ s e t - c u r r e n t
+** SEARCH ( wid -- )
+** Set the compilation word list to the word list identified by wid.
+**************************************************************************/
+static void ficlPrimitiveSetCurrent(ficlVm *vm)
+{+ ficlHash *hash = (ficlHash*)ficlStackPopPointer(vm->dataStack);
+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+ ficlDictionaryLock(dictionary, FICL_TRUE);
+ dictionary->compilationWordlist = hash;
+ ficlDictionaryLock(dictionary, FICL_FALSE);
+ return;
+}
+
+
+/**************************************************************************
+ s e t - o r d e r
+** SEARCH ( widn ... wid1 n -- )
+** Set the search order to the word lists identified by widn ... wid1.
+** Subsequently, word list wid1 will be searched first, and word list
+** widn searched last. If n is zero, empty the search order. If n is minus
+** one, set the search order to the implementation-defined minimum
+** search order. The minimum search order shall include the words
+** FORTH-WORDLIST and SET-ORDER. A system shall allow n to
+** be at least eight.
+**************************************************************************/
+static void 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] = (ficlHash*)ficlStackPopPointer(vm->dataStack);
+ }
+ }
+ else
+ {+ ficlDictionaryResetSearchOrder(dictionary);
+ }
+
+ ficlDictionaryLock(dictionary, FICL_FALSE);
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ > 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++] = (ficlHash*)ficlStackPopPointer(vm->dataStack);
+ ficlDictionaryLock(dictionary, FICL_FALSE);
+ return;
+}
+
+
+/**************************************************************************
+ 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;
+
+ hash = (ficlHash*)ficlVmPop(vm).p;
+ name = hash->name;
+
+ if (name != NULL)
+ length = strlen(name);
+ else
+ length = 0;
+
+ ficlVmPush(vm, FICL_LVALUE_TO_CELL(name));
+ ficlVmPush(vm, FICL_LVALUE_TO_CELL(length));
+ return;
+}
+
+/**************************************************************************
+ 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 = (ficlHash*)ficlVmPop(vm).p;
+ hash->name = name;
+ return;
+}
+
+
+/**************************************************************************
+ 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;
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
--- /dev/null
+++ b/softcore/classes.fr
@@ -1,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]
--- /dev/null
+++ b/softcore/ficl.fr
@@ -1,0 +1,67 @@
+\ ** ficl/softwords/softcore.fr
+\ ** FICL soft extensions
+\ ** John Sadler ([email protected])
+\ ** 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
+
--- /dev/null
+++ b/softcore/ficlclass.fr
@@ -1,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]
--- /dev/null
+++ b/softcore/ficllocal.fr
@@ -1,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
--- /dev/null
+++ b/softcore/fileaccess.fr
@@ -1,0 +1,22 @@
+S" FICL_WANT_FILE" ENVIRONMENT? drop [if]
+\ **
+\ ** File Access words for ficl
+\ ** submitted by Larry Hastings, [email protected]
+\ **
+
+: 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]
--- /dev/null
+++ b/softcore/forml.fr
@@ -1,0 +1,72 @@
+\ 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
+
--- /dev/null
+++ b/softcore/ifbrack.fr
@@ -1,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
--- /dev/null
+++ b/softcore/jhlocal.fr
@@ -1,0 +1,171 @@
+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 , ;
+\ And this is the instruction for a floating-point 0 (0.0e).
+: compiled-float-zero ficlInstructionF0 , ;
+
+
+: ?-- ( 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
+
+: {+ 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
+
+previous
+[endif]
+
--- /dev/null
+++ b/softcore/make.bat
@@ -1,0 +1,22 @@
+@echo off
+
+if "%1" == "clean" goto CLEAN
+
+if exist makesoftcore.exe goto SKIPCL
+cl /Zi /Od makesoftcore.c ..\lzcompress.c ..\bit.c
+goto MAKESOFTCORE
+
+:SKIPCL
+echo makesoftcore.exe exists, skipping building it.
+
+:MAKESOFTCORE
+echo on
+makesoftcore softcore.fr ifbrack.fr prefix.fr ficl.fr jhlocal.fr marker.fr oo.fr classes.fr string.fr win32.fr ficllocal.fr fileaccess.fr
+goto EXIT
+
+:CLEAN
+del *.obj
+del makesoftcore.exe
+del ..\softcore.c
+
+:EXIT
--- /dev/null
+++ b/softcore/makefile
@@ -1,0 +1,11 @@
+SOURCES = softcore.fr ifbrack.fr prefix.fr ficl.fr jhlocal.fr marker.fr oo.fr classes.fr string.fr ficllocal.fr fileaccess.fr
+
+softcore.c: makesoftcore $(SOURCES)
+ ./makesoftcore $(SOURCES)
+
+makesoftcore: makesoftcore.c ../lzcompress.c ../bit.c
+ $(CC) $(CFLAGS) $(CPPFLAGS) -I.. -o makesoftcore makesoftcore.c ../lzcompress.c ../bit.c
+
+clean:
+ - rm ../softcore.c *.o makesoftcore
+
--- /dev/null
+++ b/softcore/makesoftcore.c
@@ -1,0 +1,243 @@
+/*
+** 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, [email protected]
+**/
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+#include "ficl.h"
+
+
+#ifndef SOFTCORE_OUT
+#define SOFTCORE_OUT "softcore.c"
+#endif
+
+void fprintDataAsHex(FILE *f, char *data, int length)
+ {+ int i;
+ while (length)
+ {+ fprintf(f, "\t");
+ for (i = 0; (i < 8) && length; i++)
+ {+ /* if you don't do this little stuff, you get ugly sign-extended 0xFFFFFF6b crap. */
+ fprintf(f, "0x%02x, ", (unsigned)*(unsigned char*)data++);
+ length--;
+ }
+ fprintf(f, "\n");
+ }
+ }
+
+void fprintDataAsQuotedString(FILE *f, char *data)
+ {+ int i;
+ 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;
+ char *trace = uncompressed;
+ int i;
+ size_t compressedSize;
+ size_t uncompressedSize;
+ char *src, *dst;
+ FILE *f;
+ time_t currentTimeT;
+ struct tm *currentTime;
+ char cleverTime[32];
+
+ time(¤tTimeT);
+ currentTime = localtime(¤tTimeT);
+ 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 Lempel-Ziv compressed versions.\n"
+"**\n"
+"** Generated %s\n"
+"**/\n"
+"\n"
+"#include \"ficl.h\"\n"
+"\n"
+"\n",
+ cleverTime);
+
+ uncompressedSize = dst - uncompressed;
+ ficlLzCompress(uncompressed, uncompressedSize, &compressed, &compressedSize);
+
+ fprintf(f, "static size_t ficlSoftcoreUncompressedSize = %d; /* not including trailing null */\n", uncompressedSize);
+ fprintf(f, "\n");
+ fprintf(f, "#if !FICL_WANT_LZ_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_LZ_SOFTCORE */\n");
+ fprintf(f, "\n");
+ fprintf(f, "static unsigned char ficlSoftcoreCompressed[%d] = {\n", compressedSize);+ fprintDataAsHex(f, (char*)compressed, compressedSize);
+ fprintf(f, "\t};\n");
+ fprintf(f, "\n");
+ fprintf(f, "#endif /* !FICL_WANT_LZ_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_LZ_SOFTCORE\n"
+" char *ficlSoftcoreUncompressed = NULL;\n"
+" size_t gotUncompressedSize = 0;\n"
+" returnValue = ficlLzUncompress(ficlSoftcoreCompressed, &ficlSoftcoreUncompressed, &gotUncompressedSize);\n"
+" FICL_VM_ASSERT(vm, returnValue == 0);\n"
+" FICL_VM_ASSERT(vm, gotUncompressedSize == ficlSoftcoreUncompressedSize);\n"
+"#endif /* FICL_WANT_LZ_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_LZ_SOFTCORE\n"
+" free(ficlSoftcoreUncompressed);\n"
+"#endif /* FICL_WANT_LZ_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;
+ }
--- /dev/null
+++ b/softcore/marker.fr
@@ -1,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
+;
--- /dev/null
+++ b/softcore/mkfile
@@ -1,0 +1,35 @@
+</$objtype/mkfile
+
+SOURCES=\
+ softcore.fr\
+ ifbrack.fr\
+ prefix.fr\
+ prefix.fr\
+ ficl.fr\
+ jhlocal.fr\
+ marker.fr\
+ oo.fr\
+ classes.fr\
+ string.fr\
+ ficllocal.fr\
+ fileaccess.fr
+
+CC=pcc
+
+softcore.c: makesoftcore
+ makesoftcore $SOURCES
+
+makesoftcore: makesoftcore.$O lzcompress.$O bit.$O
+ $LD -o $target $prereq
+
+makesoftcore.$O: makesoftcore.c
+ $CC -I.. -c -o $target $prereq
+
+lzcompress.$O: ../lzcompress.c
+ $CC -I.. -c -o $target $prereq
+
+bit.$O: ../bit.c
+ $CC -I.. -c -o $target $prereq
+
+clean:
+ rm -f *.$O makesoftcore softcore.c
--- /dev/null
+++ b/softcore/oo.fr
@@ -1,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]
--- /dev/null
+++ b/softcore/prefix.fr
@@ -1,0 +1,47 @@
+\ **
+\ ** Prefix words for ficl
+\ ** submitted by Larry Hastings, [email protected]
+\ **
+\ (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
+
--- /dev/null
+++ b/softcore/softcore.fr
@@ -1,0 +1,152 @@
+\ ** ficl/softwords/softcore.fr
+\ ** FICL soft extensions
+\ ** John Sadler ([email protected])
+\ ** 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< ;
+
+
+
+\ ** TOOLS word set...
+: ? ( addr -- ) @ . ;
+: dump ( addr u -- )
+ 0 ?do
+ dup c@ . 1+
+ i 7 and 7 = if cr endif
+ loop drop
+;
+
+\ ** SEARCH+EXT words and ficl helpers
+.( 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
+
--- /dev/null
+++ b/softcore/string.fr
@@ -1,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]
--- /dev/null
+++ b/softcore/win32.fr
@@ -1,0 +1,211 @@
+\ **
+\ ** win32.fr
+\ ** submitted by Larry Hastings, [email protected]
+\ **
+
+
+S" FICL_PLATFORM_OS" ENVIRONMENT? drop S" WIN32" compare-insensitive 0= [if]
+
+
+: GetProcAddress ( name-addr name-u hmodule -- address )
+ 3 \ argumentCount
+ 0 \ floatArgumentBitfield
+ 2 \ cstringArgumentBitfield
+ (get-proc-address) \ functionAddress
+ [
+ multicall-calltype-function multicall-returntype-integer or literal \ flags
+ ]
+ multicall ;
+
+
+: LoadLibrary ( name-addr name-u -- hmodule )
+ 2 \ argumentCount
+ 0 \ floatArgumentBitfield
+ 1 \ cstringArgumentBitfield
+ [
+ S" LoadLibraryA" kernel32.dll GetProcAddress literal \ functionAddress
+ multicall-calltype-function multicall-returntype-integer or literal \ flags
+ ]
+ multicall ;
+
+
+: FreeLibrary ( hmodule -- success )
+ 1 \ argumentCount
+ 0 \ floatArgumentBitfield
+ 0 \ cstringArgumentBitfield
+ [
+ S" FreeLibrary" kernel32.dll GetProcAddress literal \ functionAddress
+ multicall-calltype-function multicall-returntype-integer or literal \ flags
+ ]
+ multicall ;
+
+
+: DebugBreak ( -- )
+ 0 \ argumentCount
+ 0 \ floatArgumentBitfield
+ 0 \ cstringArgumentBitfield
+ [
+ S" DebugBreak" kernel32.dll GetProcAddress literal \ functionAddress
+ multicall-calltype-function multicall-returntype-void or literal \ flags
+ ]
+ multicall ;
+
+: OutputDebugString ( addr u -- )
+ 2 \ argumentCount
+ 0 \ floatArgumentBitfield
+ 1 \ cstringArgumentBitfield
+ [
+ S" OutputDebugStringA" kernel32.dll GetProcAddress literal \ functionAddress
+ multicall-calltype-function multicall-returntype-void or literal \ flags
+ ]
+ multicall ;
+
+: GetTickCount ( -- ticks )
+ 0 \ argumentCount
+ 0 \ floatArgumentBitfield
+ 0 \ cstringArgumentBitfield
+ [
+ S" GetTickCount" kernel32.dll GetProcAddress literal \ functionAddress
+ multicall-calltype-function multicall-returntype-integer or literal \ flags
+ ]
+ multicall ;
+
+S" user32.dll" LoadLibrary constant user32.dll
+
+: MessageBox ( flags title-addr title-u body-addr body-u hwnd -- button )
+ 6 \ argumentCount
+ 0 \ floatArgumentBitfield
+ [
+ 2 8 or literal \ cstringArgumentBitfield
+ S" MessageBoxA" user32.dll GetProcAddress literal \ functionAddress
+ multicall-calltype-function multicall-returntype-integer or literal \ flags
+ ]
+ multicall ;
+
+
+\ Constants for use with MessageBox
+\ the ID* names are possible return values.
+
+0x00000000 constant MB_OK
+0x00000001 constant MB_OKCANCEL
+0x00000002 constant MB_ABORTRETRYIGNORE
+0x00000003 constant MB_YESNOCANCEL
+0x00000004 constant MB_YESNO
+0x00000005 constant MB_RETRYCANCEL
+0x00000010 constant MB_ICONHAND
+0x00000020 constant MB_ICONQUESTION
+0x00000030 constant MB_ICONEXCLAMATION
+0x00000040 constant MB_ICONASTERISK
+0x00000080 constant MB_USERICON
+0x00000000 constant MB_DEFBUTTON1
+0x00000100 constant MB_DEFBUTTON2
+0x00000200 constant MB_DEFBUTTON3
+0x00000300 constant MB_DEFBUTTON4
+0x00000000 constant MB_APPLMODAL
+0x00001000 constant MB_SYSTEMMODAL
+0x00002000 constant MB_TASKMODAL
+0x00004000 constant MB_HELP
+0x00008000 constant MB_NOFOCUS
+0x00010000 constant MB_SETFOREGROUND
+0x00020000 constant MB_DEFAULT_DESKTOP_ONLY
+0x00040000 constant MB_TOPMOST
+0x00080000 constant MB_RIGHT
+0x00100000 constant MB_RTLREADING
+
+MB_ICONEXCLAMATION constant MB_ICONWARNING
+MB_ICONHAND constant MB_ICONERROR
+MB_ICONASTERISK constant MB_ICONINFORMATION
+MB_ICONHAND constant MB_ICONSTOP
+
+
+0x00200000 constant MB_SERVICE_NOTIFICATION
+0x00040000 constant MB_SERVICE_NOTIFICATION
+0x00040000 constant MB_SERVICE_NOTIFICATION_NT3X
+
+0x0000000F constant MB_TYPEMASK
+0x000000F0 constant MB_ICONMASK
+0x00000F00 constant MB_DEFMASK
+0x00003000 constant MB_MODEMASK
+0x0000C000 constant MB_MISCMASK
+
+
+1 constant IDOK
+2 constant IDCANCEL
+3 constant IDABORT
+4 constant IDRETRY
+5 constant IDIGNORE
+6 constant IDYES
+7 constant IDNO
+8 constant IDCLOSE
+9 constant IDHELP
+
+
+\ ** old names
+: output-debug-string OutputDebugString ;
+: debug-break DebugBreak ;
+
+
+: uaddr->cstring { addr u | cstring -- cstring }+ u 1+ allocate
+ 0= if
+ to cstring
+ addr cstring u move
+ 0 cstring u + c!
+ cstring
+ else
+ 0
+ endif
+ ;
+
+\ **
+\ ** The following four calls:
+\ ** callnativeFunction
+\ ** callcFunction
+\ ** callpascalFunction
+\ ** vcall
+\ ** are deprecated. Please use the more powerful "multicall" instead.
+\ **
+
+\ ** My original native function caller, reimplemented in Ficl using multicall.
+: callnativeFunction { functionAddress popStack -- }+ 0 \ floatArgumentBitfield
+ 0 \ cstringArgumentBitfield
+ functionAddress \ functionAddress
+
+ [
+ multicall-calltype-function
+ multicall-returntype-integer or
+ multicall-reverse-arguments or
+ literal
+ ]
+
+ multicall
+ ;
+
+
+\ ** simple wrappers for callnativeFunction that specify the calling convention
+: callcfunction 1 callnativeFunction ;
+: callpascalfunction 0 callnativeFunction ;
+
+
+\ ** Guy Carver's "vcall" function, reimplemented in Ficl using multicall.
+: vcall { argumentCount index -- }+ argumentCount 0x80000000 invert or \ cleaned-up argumentCount
+ 0 \ cstringArgumentBitfield
+ 0 \ cstringFlags
+ index \ index
+
+ \ flags:
+ argumentCount 0x80000000 and if multicall-returntype-integer else multicall-returntype-void endif
+
+ [
+ multicall-calltype-virtual-method
+ multicall-reverse-arguments or
+ literal
+ ] or
+
+ multicall
+ ;
+
+[endif]
+
--- /dev/null
+++ b/stack.c
@@ -1,0 +1,420 @@
+/*******************************************************************
+** s t a c k . c
+** Forth Inspired Command Language
+** Author: John Sadler ([email protected])
+** Created: 16 Oct 1997
+** $Id: stack.c,v 1.15 2010/12/04 21:38:47 asau Exp $
+*******************************************************************/
+/*
+** Copyright (c) 1997-2001 John Sadler ([email protected])
+** 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 <stdlib.h>
+
+#include "ficl.h"
+
+/*
+** 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 depth = ficlStackDepth(stack);
+ int nFree = stack->size - depth;
+
+ if (popCells > depth)
+ {+ ficlVmThrowError(stack->vm, "Error: %s stack underflow", stack->name);
+ }
+
+ if (nFree < pushCells - popCells)
+ {+ ficlVmThrowError(stack->vm, "Error: %s stack overflow", stack->name);
+ }
+
+ return;
+}
+#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)
+{+ ficlCell *base = (ficlCell*)ficlMalloc(size * sizeof (ficlCell));
+ ficlStack *stack = (ficlStack*)ficlMalloc(sizeof (ficlStack));
+
+ FICL_VM_ASSERT(vm, size != 0);
+ FICL_VM_ASSERT(vm, base != NULL);
+ FICL_VM_ASSERT(vm, stack != NULL);
+
+ stack->size = size;
+ stack->base = base;
+ 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 != NULL) {+ if (stack->base != NULL)
+ ficlFree(stack->base);
+ ficlFree(stack);
+ }
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k D e p t h
+**
+*******************************************************************/
+
+int ficlStackDepth(ficlStack *stack)
+{+ return (stack->top - stack->base) + 1;
+}
+
+/*******************************************************************
+ 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;
+ return;
+}
+
+
+/*******************************************************************
+ 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;
+ return;
+}
+
+
+/*******************************************************************
+ 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;
+ return;
+}
+
+
+/*******************************************************************
+ 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 = (ficlCell*)ficlStackPopPointer(stack);
+ return;
+}
+#endif /* FICL_WANT_LOCALS */
+
+
+/*******************************************************************
+ s t a c k P i c k
+**
+*******************************************************************/
+
+void ficlStackPick(ficlStack *stack, int n)
+{+ ficlStackPush(stack, ficlStackFetch(stack, n));
+ return;
+}
+
+
+/*******************************************************************
+ 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)
+{+ *++stack->top = FICL_LVALUE_TO_CELL(ptr);
+}
+
+void ficlStackPushInteger(ficlStack *stack, ficlInteger i)
+{+ *++stack->top = FICL_LVALUE_TO_CELL(i);
+}
+
+void ficlStackPushUnsigned(ficlStack *stack, ficlUnsigned u)
+{+ *++stack->top = FICL_LVALUE_TO_CELL(u);
+}
+
+void ficlStackPush2Unsigned(ficlStack *stack, ficl2Unsigned du)
+{+ ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_LOW(du));
+ ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_HIGH(du));
+ return;
+}
+
+void ficlStackPush2Integer(ficlStack *stack, ficl2Integer di)
+{+ ficlStackPush2Unsigned(stack, FICL_2INTEGER_TO_2UNSIGNED(di));
+ return;
+}
+
+#if (FICL_WANT_FLOAT)
+void ficlStackPushFloat(ficlStack *stack, ficlFloat f)
+{+ *++stack->top = FICL_LVALUE_TO_CELL(f);
+}
+#endif
+
+
+/*******************************************************************
+ s t a c k R e s e t
+**
+*******************************************************************/
+
+void ficlStackReset(ficlStack *stack)
+{+ stack->top = stack->base - 1;
+ return;
+}
+
+
+/*******************************************************************
+ s t a c k R o l l
+** Roll nth stack entry to the top (counting from zero), if n is
+** >= 0. Drop other entries as needed to fill the hole.
+** If n < 0, roll top-of-stack to nth entry, pushing others
+** upward as needed to fill the hole.
+*******************************************************************/
+
+void 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;
+ }
+ return;
+}
+
+
+/*******************************************************************
+ 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;
+ return;
+}
+
+
+
+
+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;
+ }
+ return;
+}
+
+
--- /dev/null
+++ b/system.c
@@ -1,0 +1,466 @@
+/*******************************************************************
+** f i c l . c
+** Forth Inspired Command Language - external interface
+** Author: John Sadler ([email protected])
+** Created: 19 July 1997
+** $Id: system.c,v 1.4 2010/12/02 13:56:43 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 ([email protected])
+** 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 <stdlib.h>
+#include <string.h>
+#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 = 0;
+ int minor = 0;
+ ficl2Integer combined;
+ ficlDictionary *environment = ficlSystemGetEnvironment(system);
+ sscanf(FICL_VERSION, "%d.%d", &major, &minor);
+ FICL_2INTEGER_SET(major, minor, combined);
+ ficlDictionarySet2Constant(environment, "ficl-version", combined);
+ ficlDictionarySetConstant(environment, "ficl-robust", FICL_ROBUST);
+ return;
+}
+
+
+
+
+
+/**************************************************************************
+ 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 = (ficlSystem*)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_DICTIONARY_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_LZ_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);
+ }
+
+ ficlFree(system);
+ system = NULL;
+
+ if (ficlSystemGlobal == system)
+ ficlSystemGlobal = NULL;
+
+ return;
+}
+
+
+/**************************************************************************
+ 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 = ficlDictionaryAppendPrimitive(dictionary, name, ficlPrimitiveParseStepParen, FICL_WORD_DEFAULT);
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(pStep));
+ 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);
+ return;
+}
+
+
+/**************************************************************************
+ 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
+
+
--- /dev/null
+++ b/test/asm68k.4th
@@ -1,0 +1,300 @@
+HEX
+4e71 constant nop
+
+\ w, ( WORD compile )
+: w, ( d16 -- ) dup 100 / c, c, ;
+
+: OCTAL 8 BASE ! ;
+
+
+\ FORTH ASSEMBLER ....
+
+ALSO FORTH
+VOCABULARY ASSEMBLER IMMEDIATE
+ASSEMBLER DEFINITIONS
+
+: END-CODE ALIGN CURRENT @ CONTEXT ! ;
+: *SWAP SWAP ;
+: ?, IF w, THEN w, ;
+
+\ SIZES
+
+OCTAL
+VARIABLE SIZE
+: BYTE 10000 SIZE ! ;
+: WORD 30100 SIZE ! ;
+: LONG 24600 SIZE ! ;
+: SZ CREATE , DOES> @ SIZE @ AND OR ;
+
+00300 SZ SZ3
+00400 SZ SZ4
+04000 SZ SZ40
+30000 SZ SZ300
+
+: LONG? SIZE @ 24600 = ;
+: -SZ1 LONG? IF 100 OR THEN ;
+
+\ ADDRESSING MODES
+
+: REGS 10 0 DO DUP 1001 I * OR CONSTANT LOOP DROP ;
+: MODE CREATE , DOES> @ SWAP 7007 AND OR ;
+
+0000 REGS D0 D1 D2 D3 D4 D5 D6 D7
+0110 REGS A0 A1 A2 A3 A4 A5 A6 A7
+
+0220 MODE )
+0330 MODE )+
+0440 MODE -)
+0550 MODE D)
+0660 MODE DI)
+0770 CONSTANT #)
+1771 CONSTANT L#)
+2772 CONSTANT PCD)
+3773 CONSTANT PCDI)
+4774 CONSTANT #
+
+\ FIELDS AND REGISTER ASSIGNMENTS
+
+: FIELD CREATE , DOES> @ AND ;
+
+7000 FIELD RD
+0007 FIELD RS
+0070 FIELD MS
+0077 FIELD EAS
+0377 FIELD LOW
+
+: DN? DUP MS 0 = ;
+: SRC OVER EAS OR ;
+: DST SWAP RD OR ;
+
+A7 CONSTANT SP
+A6 CONSTANT RP
+A5 CONSTANT IP
+
+: ?MODE 0 = ABORT" BAD MODE" ;
+: ??Dn DN? ?MODE ;
+: ??An DUP MS 1 = ?MODE ;
+: ??JMP DUP MS DUP 2 = SWAP 4 > OR OVER 74 = NOT AND ?MODE ;
+
+\ EXTENDED ADDRESSING
+
+: DOUBLE? DUP L#) = SWAP # = LONG? AND OR ;
+: INDEX?
+ DUP >R DUP 0770 AND A0 DI) = SWAP PCDI) = OR
+ IF DUP RD 10 * SWAP MS IF 100000 OR THEN
+ SZ40 SWAP LOW OR
+ THEN R> ;
+: MORE? DUP MS 0040 > ;
+: ,MORE MORE? IF INDEX? DOUBLE? ?, ELSE DROP THEN ;
+
+\ EXTENDED ADDRESSING EXTRAS
+
+CREATE EXTRA HERE 10 ALLOT 10 ERASE
+
+: EXTRA? MORE?
+ IF >R R@ INDEX? DOUBLE? EXTRA 1 + SWAP
+ IF 2! 2 ELSE ! 1 THEN EXTRA C! R>
+ ELSE 0 EXTRA ! THEN ;
+: ,EXTRA EXTRA C@ ?DUP
+ IF EXTRA 1 + SWAP 1 =
+ IF @ w, ELSE 2@ , THEN EXTRA 10 ERASE
+ THEN ;
+
+\ IMMEDIATE & ADDRESS REGISTER SPECIFIC INSTRUCTIONS
+
+: IMM CREATE , DOES> @ >R EXTRA? EAS R> OR SZ3 w, LONG? ?, ,EXTRA ;
+0000 IMM ORI
+1000 IMM ANDI
+2000 IMM SUBI
+3000 IMM ADDI
+5000 IMM EORI
+6000 IMM CMPI
+
+: IMMSR CREATE , DOES> @ SZ3 , ;
+001074 IMMSR ANDI>SR
+005074 IMMSR EORI>SR
+000074 IMMSR ORI>SR
+
+: IQ CREATE , DOES> @ >R EXTRA? EAS SWAP RS 1000 * OR R> OR SZ3 w, ,EXTRA ;
+050000 IQ ADDQ
+050400 IQ SUBQ
+
+: IEAA CREATE , DOES> @ DST SRC SZ4 w, ,MORE ;
+150300 IEAA ADDA
+130300 IEAA CMPA
+040700 IEAA LEA
+110300 IEAA SUBA
+
+\ SHIFTS, ROTATES, & BIT MANIPULATION
+: ISR CREATE , DOES> @ >R DN?
+ IF SWAP DN? IF R> 40 OR >R ELSE DROP SWAP 1000 * THEN
+ RD SWAP RS OR R> OR 160000 OR SZ3 w,
+ ELSE DUP EAS 300 OR R@ 400 AND OR R> 70 AND 100 * OR
+ 160000 OR w, ,MORE
+ THEN ;
+400 ISR ASL
+000 ISR ASR
+410 ISR LSL
+010 ISR LSR
+420 ISR ROXL
+020 ISR ROXR
+430 ISR ROL
+030 ISR ROR
+
+: IBIT CREATE , DOES> @ >R EXTRA? DN?
+ IF RD SRC 400 ELSE DROP DUP EAS 4000 THEN
+ OR R> OR w, ,EXTRA ,MORE ;
+000 IBIT BTST
+100 IBIT BCHG
+200 IBIT BCLR
+300 IBIT BSET
+
+\ BRANCH, LOOP, & SET CONDITIONALS
+
+: SETCLASS ' SWAP 0 DO I OVER EXECUTE LOOP DROP ;
+: SETCLAS2 ' ROT ROT DO I OVER EXECUTE LOOP DROP ;
+: IBRA 400 * 060000 OR CREATE ,
+ DOES> @ SWAP HERE 2 + - DUP ABS 200 <
+ IF LOW OR w, ELSE SWAP , THEN ;
+: IDBR 400 * 050310 OR CREATE ,
+ DOES> @ SWAP RS OR w, HERE - , ;
+: ISET 400 * 050300 OR CREATE ,
+ DOES> @ SRC w, ,MORE ;
+
+20 SETCLASS IBRA BRA BSR BHI BLS BCC BCS BNE BEQ BVC BVS BPL BMI BGE BLT BGT BLE
+
+10 SETCLASS IDBR DXIT DBRA DBHI DBLS DBCC DBCS DBNE DBEQ
+
+20 10 SETCLAS2 IDBR DBVC DBVS DBPL DBMI DBGE DBLT DBGT DBLE
+
+20 SETCLASS ISET SET SNO SHI SLS SCC SCS SNE SEQ SVC SVS SPL SMI SGE SLT SGT SLE
+
+\ MOVES
+
+: MOVE EXTRA? 7700 AND SRC SZ300 w, ,MORE ,EXTRA ;
+
+: MOVEQ RD SWAP LOW OR 070000 OR w, ;
+
+: MOVE>USP RS 047140 OR w, ;
+: MOVE<USP RS 047150 OR w, ;
+: MOVEM> EXTRA? EAS 044200 OR -SZ1 w, w, ,EXTRA ;
+: MOVEM< EXTRA? EAS 046200 OR -SZ1 w, w, ,EXTRA ;
+: MOVEP DN? IF RD SWAP RS OR 410 OR
+ ELSE RS ROT RD OR 610 OR
+ THEN -SZ1 , ;
+: LMOVE 7700 AND SWAP EAS OR 20000 OR w, ;
+
+\ ODDS AND ENDS
+
+: CMPM RD SWAP RS OR 130410 OR SZ3 w, ;
+: EXG
+ DN? IF SWAP DN? IF 140500 ELSE 140610 THEN >R
+ ELSE SWAP DN? IF 140610 ELSE 140510 THEN >R SWAP
+ THEN RS DST R> OR w, ;
+: EXT RS 044200 OR -SZ1 w, ;
+: SWAP RS 044100 OR w, ;
+: STOP 47162 , ;
+: TRAP 17 AND 47100 OR w, ;
+: LINK RS 047120 OR , ;
+: UNLK RS 047130 OR w, ;
+
+\ ARITHMETIC & LOGIC
+
+: EOR EXTRA? EAS DST SZ3 130400 OR w, ,EXTRA ;
+
+: IDD CREATE ,
+ DOES> @ DST OVER RS OR *SWAP MS IF 10 OR THEN w, ;
+
+140400 IDD ABCD
+100400 IDD SBCD
+150300 IDD ADDX
+110400 IDD SUBX
+
+: IDEA CREATE ,
+ DOES> @ >R DN?
+ IF RD SRC R> OR SZ3 w, ,MORE
+ ELSE EXTRA? EAS DST 400 OR R> OR SZ3 w, ,EXTRA THEN ;
+
+150000 IDEA ADD
+110000 IDEA SUB
+140000 IDEA AND
+100000 IDEA OR
+
+: IEAD CREATE , DOES> @ DST SRC w, ,MORE ;
+
+040600 IEAD CHK
+100300 IEAD DIVU
+100700 IEAD DIVS
+140300 IEAD MULU
+140700 IEAD MULS
+
+: CMP 130000 DST SRC SZ3 w, ,MORE ;
+
+\ ARITHMETIC & CONTROL
+
+
+: IEA CREATE , DOES> @ SRC w, ,MORE ;
+
+047200 IEA JSR
+047300 IEA JMP
+042300 IEA MOVE>CCR
+040300 IEA MOVE<SR
+043300 IEA MOVE>SR
+044000 IEA NBCD
+044100 IEA PEA
+045300 IEA TAS
+
+: IEAS CREATE , DOES> @ SRC SZ3 w, ,MORE ;
+
+041000 IEAS CLR
+043000 IEAS NOT
+042000 IEAS NEG
+040000 IEAS NEGX
+045000 IEAS TST
+
+: ICON CREATE , DOES> @ w, ;
+
+47160 ICON RESET
+47161 ICON NOP
+47163 ICON RTE
+47165 ICON RTS
+47166 ICON TRAPV
+47167 ICON RTR
+
+\ STRUCTURED CONDITIONALS ( +/- 256 BYTES )
+
+: THEN HERE OVER 2 + - *SWAP 1 + C! ;
+: ENDIF THEN ;
+: IF w, HERE 2 - ;
+
+HEX
+
+: ELSE 6000 IF *SWAP THEN ;
+: BEGIN HERE ;
+: UNTIL , HERE - HERE 1 - C! ;
+: AGAIN 6000 UNTIL ;
+: WHILE IF ;
+: REPEAT *SWAP AGAIN THEN ;
+: DO HERE *SWAP ;
+: LOOP DBRA ;
+
+6600 CONSTANT 0=
+6700 CONSTANT 0<>
+6A00 CONSTANT 0<
+6B00 CONSTANT 0>=
+6C00 CONSTANT <
+6D00 CONSTANT >=
+6E00 CONSTANT <=
+6F00 CONSTANT >
+
+DECIMAL
+
+: NEXT
+ A5 )+ A0 LMOVE
+ A0 ) JMP ;
+
+FORTH DEFINITIONS
+
+: LABEL CREATE [COMPILE] ASSEMBLER ASSEMBLER WORD ;
+: CODE LABEL HERE CELL- CELL- CELL- CP ! ;
+
--- /dev/null
+++ b/test/core.fr
@@ -1,0 +1,997 @@
+\ 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 }+
+
--- /dev/null
+++ b/test/fib.fr
@@ -1,0 +1,12 @@
+: fib ( n1 -- n2 )
+ dup 1 > if
+ dup
+ 1- recurse
+ swap 2 - recurse
+ +
+ then ;
+
+
+35 value nfibs
+: fibtest nfibs fib . cr ;
+
--- /dev/null
+++ b/test/ficltest.fr
@@ -1,0 +1,106 @@
+\ 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
+;
+
+load tester.fr
+load 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. -> 0 3 }+
+
+s" ficlwin" environment?
+[if]
+drop
+testing OOP support
+load ooptest.fr
+[endif]
+
--- /dev/null
+++ b/test/ooptest.fr
@@ -1,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
--- /dev/null
+++ b/test/prefix.fr
@@ -1,0 +1,8 @@
+: 0x { | old-base -- n }+ base @ to old-base
+ 16 base !
+ 0 0 parse-word >number 2drop drop
+ old-base base !
+;
+
+
\ No newline at end of file
--- /dev/null
+++ b/test/sarray.fr
@@ -1,0 +1,17 @@
+\ 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
+
--- /dev/null
+++ b/test/testcase.fr
@@ -1,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
--- /dev/null
+++ b/test/tester.fr
@@ -1,0 +1,59 @@
+\ From: John Hayes S1I
+\ Subject: tester.fr
+\ Date: Mon, 27 Nov 95 13:10:09 PST
+\ [email protected]
+\ (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 ;
+
--- /dev/null
+++ b/test/vocab.fr
@@ -1,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 ;
--- /dev/null
+++ b/tools.c
@@ -1,0 +1,927 @@
+/*******************************************************************
+** t o o l s . c
+** Forth Inspired Command Language - programming tools
+** Author: John Sadler ([email protected])
+** Created: 20 June 2000
+** $Id: tools.c,v 1.16 2010/12/02 22:14:12 asau Exp $
+*******************************************************************/
+/*
+** Copyright (c) 1997-2001 John Sadler ([email protected])
+** 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 <stdlib.h>
+#include <stdint.h>
+#include <stdio.h> /* sprintf */
+#include <string.h>
+#include <ctype.h>
+#include "ficl.h"
+
+
+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)
+{+ ficlVmTextOut(vm, "dbg> ");
+}
+
+
+#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);
+
+ return;
+}
+#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", word->param->i, word->param->u);
+ ficlVmTextOut(vm, vm->pad);
+ break;
+
+#if FICL_WANT_USER
+ case FICL_WORDKIND_USER:
+ sprintf(vm->pad, "user variable %ld (%#lx)\n", word->param->i, word->param->u);
+ ficlVmTextOut(vm, vm->pad);
+ break;
+#endif
+
+ case FICL_WORDKIND_CONSTANT:
+ sprintf(vm->pad, "constant = %ld (%#lx)\n", word->param->i, word->param->u);
+ ficlVmTextOut(vm, vm->pad);
+ break;
+
+ case FICL_WORDKIND_2CONSTANT:
+ sprintf(vm->pad, "constant = %ld %ld (%#lx %#lx)\n", word->param[1].i, word->param->i, word->param[1].u, 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");
+ }
+
+ return;
+}
+
+
+static void ficlPrimitiveSee(ficlVm *vm)
+{+ ficlPrimitiveTick(vm);
+ ficlPrimitiveSeeXT(vm);
+ return;
+}
+
+
+/**************************************************************************
+ 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 = (ficlWord*)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;
+ }
+
+ return;
+}
+
+
+/**************************************************************************
+ 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));
+
+ return;
+}
+
+
+/**************************************************************************
+ 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;
+ }
+
+ return;
+}
+
+
+/**************************************************************************
+ 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;
+ ficlWordKind kind;
+
+ 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;
+
+ kind = ficlWordClassify(word);
+
+ switch (kind)
+ {+ case FICL_WORDKIND_INSTRUCTION:
+ case FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT:
+ sprintf(vm->pad, "next: %s (instruction %ld)\n", ficlDictionaryInstructionNames[(long)word], (long)word);
+ break;
+ default:
+ sprintf(vm->pad, "next: %s\n", word->name);
+ break;
+ }
+
+ ficlVmTextOut(vm, vm->pad);
+ ficlDebugPrompt(vm);
+ }
+ 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':
+ {+ ficlVmTextOut(vm, FICL_PROMPT);
+ 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");
+ }
+
+ 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);
+ ficlVmThrow(vm, FICL_VM_STATUS_RESTART);
+ break;
+ }
+ }
+
+ return;
+}
+
+
+/**************************************************************************
+ b y e
+** TOOLS
+** Signal the system to shut down - this causes ficlExec to return
+** VM_USEREXIT. The rest is up to you.
+**************************************************************************/
+static void ficlPrimitiveBye(ficlVm *vm)
+{+ ficlVmThrow(vm, FICL_VM_STATUS_USER_EXIT);
+ return;
+}
+
+
+/**************************************************************************
+ 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[64];
+ sprintf(buffer, "[0x%08jx %3d]: %12jd (0x%08jx)\n", (uintmax_t)cell, context->count++, (intmax_t)cell->i, (uintmax_t)cell->i);
+ 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);
+
+ sprintf(buffer, "[%s stack has %d entries, top at 0x%08jx]\n", stack->name, ficlStackDepth(stack), (uintmax_t)stack->top);
+ ficlVmTextOut(vm, buffer);
+
+ if (callback == NULL)
+ {+ myContext.vm = vm;
+ myContext.count = 0;
+ context = &myContext;
+ callback = ficlStackDisplayCallback;
+ }
+ ficlStackWalk(stack, callback, context, FICL_FALSE);
+
+ sprintf(buffer, "[%s stack base at 0x%08jx]\n", stack->name, (uintmax_t)stack->base);
+ ficlVmTextOut(vm, buffer);
+
+ return;
+}
+
+
+void ficlVmDisplayDataStack(ficlVm *vm)
+{+ ficlStackDisplay(vm->dataStack, NULL, NULL);
+ return;
+}
+
+
+
+
+static ficlInteger ficlStackDisplaySimpleCallback(void *c, ficlCell *cell)
+{+ struct stackContext *context = (struct stackContext *)c;
+ char buffer[32];
+ sprintf(buffer, "%s%jd", context->count ? " " : "", (intmax_t)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);
+ return;
+}
+
+
+
+
+static ficlInteger ficlReturnStackDisplayCallback(void *c, ficlCell *cell)
+{+ struct stackContext *context = (struct stackContext *)c;
+ char buffer[128];
+
+ sprintf(buffer, "[0x%08jx %3d] %12jd (0x%08jx)", (uintmax_t)cell, context->count++, (intmax_t)cell->i, (uintmax_t)cell->i);
+
+ /*
+ ** 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 = ficlDictionaryFindEnclosingWord(context->dictionary, (ficlCell*)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);
+ return;
+}
+
+
+
+
+/**************************************************************************
+ 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);
+
+ return;
+}
+
+
+/**************************************************************************
+ f o r g e t
+** TOOLS EXT ( "<spaces>name" -- )
+** Skip leading space delimiters. Parse name delimited by a space.
+** Find name, then delete name from the dictionary along with all
+** words added to the dictionary after name. An ambiguous
+** condition exists if name cannot be found.
+**
+** If the Search-Order word set is present, FORGET searches the
+** compilation word list. An ambiguous condition exists if the
+** compilation word list is deleted.
+**************************************************************************/
+static void 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);
+
+ return;
+}
+
+
+/**************************************************************************
+ 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 = vm->pad;
+
+ 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;
+
+ cp = wp->name;
+ nChars += sprintf(pPad + nChars, "%s", cp);
+
+ if (nChars > 70)
+ {+ pPad[nChars++] = '\n';
+ pPad[nChars] = '\0';
+ nChars = 0;
+ ficlVmTextOut(vm, pPad);
+ }
+ else
+ {+ len = nCOLWIDTH - nChars % nCOLWIDTH;
+ while (len-- > 0)
+ pPad[nChars++] = ' ';
+ }
+
+ if (nChars > 70)
+ {+ pPad[nChars++] = '\n';
+ pPad[nChars] = '\0';
+ nChars = 0;
+ ficlVmTextOut(vm, pPad);
+ }
+ }
+ }
+
+ if (nChars > 0)
+ {+ pPad[nChars++] = '\n';
+ pPad[nChars] = '\0';
+ nChars = 0;
+ ficlVmTextOut(vm, pPad);
+ }
+
+ sprintf(vm->pad, "Dictionary: %d words, %ld cells used of %u total\n",
+ nWords, (long) (dictionary->here - dictionary->base), dictionary->size);
+ ficlVmTextOut(vm, vm->pad);
+ return;
+}
+
+
+/**************************************************************************
+ 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;
+
+ for (i = 0; i < hash->size; i++)
+ {+ for (word = hash->table[i]; word != NULL; word = word->link, counter++)
+ {+ ficlVmTextOut(vm, word->name);
+ ficlVmTextOut(vm, "\n");
+ }
+ }
+
+ sprintf(vm->pad, "Environment: %d words, %ld cells used of %u total\n",
+ counter, (long) (dictionary->here - dictionary->base), dictionary->size);
+ ficlVmTextOut(vm, vm->pad);
+ return;
+}
+
+
+
+
+/*
+** 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;
+ }
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+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);
+ return;
+}
+
+
+/**************************************************************************
+ 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
+
+ return;
+}
+
--- /dev/null
+++ b/utility.c
@@ -1,0 +1,262 @@
+#include <ctype.h>
+
+#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 )
+{ /* reverse a string in-place */+ int i = strlen(string);
+ char *p1 = string; /* first char of string */
+ char *p2 = string + i - 1; /* last non-NULL char of string */
+ char c;
+
+ if (i > 1)
+ {+ while (p1 < p2)
+ {+ c = *p2;
+ *p2 = *p1;
+ *p1 = c;
+ p1++; p2--;
+ }
+ }
+
+ return string;
+}
+
+
+/**************************************************************************
+ d i g i t _ t o _ c h a r
+**
+**************************************************************************/
+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 )
+{ /* convert long to string, any base */+ 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 )
+{ /* convert long to string, any base */+ 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);
+ }
+}
--- /dev/null
+++ b/vm.c
@@ -1,0 +1,3099 @@
+/*******************************************************************
+** v m . c
+** Forth Inspired Command Language - virtual machine methods
+** Author: John Sadler ([email protected])
+** Created: 19 July 1997
+** $Id: vm.c,v 1.22 2010/12/22 09:05:52 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 ([email protected])
+** 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 <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
+#include <ctype.h>
+#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;
+ return;
+}
+
+
+/**************************************************************************
+ 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);
+ }
+
+ return;
+}
+
+
+
+
+/**************************************************************************
+ 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);
+ return;
+}
+
+
+
+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 + *(int *)ip;
+ switch ((ficlInstruction)*destination)
+ {+ case ficlInstructionBranchParenWithCheck:
+ /* preoptimize where we're jumping to */
+ ficlVmOptimizeJumpToJump(vm, destination);
+ case ficlInstructionBranchParen:
+ {+ destination++;
+ destination += *(int *)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;
+#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;
+
+ LOCAL_VARIABLE_REFILL;
+
+ oldExceptionHandler = vm->exceptionHandler;
+ vm->exceptionHandler = &exceptionHandler; /* This has to come before the setjmp! */
+ except = setjmp(exceptionHandler);
+
+ 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;
+ break;
+ }
+
+ 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;
+ break;
+ }
+
+ /**************************************************************************
+ ** 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 = (char *)ficlAlignPointer(cp);
+ ip = (ficlInstruction *)cp;
+ break;
+ }
+
+ case ficlInstructionCStringLiteralParen:
+ {+ CHECK_STACK(0, 1);
+
+ s = (ficlCountedString *)(ip);
+ cp = s->text + s->length + 1;
+ cp = (char *)ficlAlignPointer(cp);
+ ip = (ficlInstruction *)cp;
+ (++dataTop)->p = s;
+ break;
+ }
+
+
+#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];
+ break;
+
+ FLOAT_POP_CELL_POINTER_MINIPROC:
+ cell[0] = *floatTop--;
+ break;
+ FLOAT_POP_CELL_POINTER_DOUBLE_MINIPROC:
+ cell[0] = *floatTop--;
+ cell[1] = *floatTop--;
+ break;
+
+ #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];
+ break;
+
+ POP_CELL_POINTER_MINIPROC:
+ cell[0] = *dataTop--;
+ break;
+ POP_CELL_POINTER_DOUBLE_MINIPROC:
+ cell[0] = *dataTop--;
+ cell[1] = *dataTop--;
+ break;
+
+ #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 += *(ficlInstruction *)ip;
+ break;
+
+ #define BRANCH() goto BRANCH_MINIPROC
+
+ EXIT_FUNCTION_MINIPROC:
+ ip = (ficlInstruction *)((returnTop--)->p);
+ break;
+
+ #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; break
+ #define FLOAT_PUSH_CELL_POINTER(cp) cell = (cp); *++floatTop = *cell; break
+ #define FLOAT_POP_CELL_POINTER_DOUBLE(cp) cell = (cp); *cell = *floatTop--; cell[1] = *floatTop--; break
+ #define FLOAT_POP_CELL_POINTER(cp) cell = (cp); *cell = *floatTop--; break
+ #endif /* FICL_WANT_FLOAT */
+
+ #define PUSH_CELL_POINTER_DOUBLE(cp) cell = (cp); *++dataTop = cell[1]; *++dataTop = *cell; break
+ #define PUSH_CELL_POINTER(cp) cell = (cp); *++dataTop = *cell; break
+ #define POP_CELL_POINTER_DOUBLE(cp) cell = (cp); *cell = *dataTop--; cell[1] = *dataTop--; break
+ #define POP_CELL_POINTER(cp) cell = (cp); *cell = *dataTop--; break
+
+ #define BRANCH() ip += *(ficlInteger *)ip; break
+ #define EXIT_FUNCTION() ip = (ficlInstruction *)((returnTop--)->p); break
+
+#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++;
+ break;
+ }
+
+ case ficlInstruction2LiteralParen:
+ {+ CHECK_STACK(0, 2);
+ (++dataTop)->i = ip[1];
+ (++dataTop)->i = ip[0];
+ ip += 2;
+ break;
+ }
+
+
+#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;
+ break;
+ }
+
+
+ /**************************************************************************
+ ** Unink a stack frame previously created by stackLink
+ ** 1) dataTop = frame
+ ** 2) frame = pop()
+ *******************************************************************/
+ case ficlInstructionUnlinkParen:
+ {+ returnTop = frame - 1;
+ frame = (ficlCell *)(returnTop--)->p;
+ break;
+ }
+
+
+ /**************************************************************************
+ ** 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;
+ break;
+ }
+
+ case ficlInstructionMinus:
+ {+ CHECK_STACK(2, 1);
+ i = (dataTop--)->i;
+ dataTop->i -= i;
+ break;
+ }
+
+ case ficlInstruction1Plus:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i++;
+ break;
+ }
+
+ case ficlInstruction1Minus:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i--;
+ break;
+ }
+
+ case ficlInstruction2Plus:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i += 2;
+ break;
+ }
+
+ case ficlInstruction2Minus:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i -= 2;
+ break;
+ }
+
+ case ficlInstructionDup:
+ {+ ficlInteger i = dataTop->i;
+ CHECK_STACK(0, 1);
+ (++dataTop)->i = i;
+ break;
+ }
+
+ case ficlInstructionQuestionDup:
+ {+ CHECK_STACK(1, 2);
+
+ if (dataTop->i != 0)
+ {+ dataTop[1] = dataTop[0];
+ dataTop++;
+ }
+
+ break;
+ }
+
+ case ficlInstructionSwap:
+ {+ ficlCell swap;
+ CHECK_STACK(2, 2);
+ swap = dataTop[0];
+ dataTop[0] = dataTop[-1];
+ dataTop[-1] = swap;
+ break;
+ }
+
+ case ficlInstructionDrop:
+ {+ CHECK_STACK(1, 0);
+ dataTop--;
+ break;
+ }
+
+
+ case ficlInstruction2Drop:
+ {+ CHECK_STACK(2, 0);
+ dataTop -= 2;
+ break;
+ }
+
+
+ case ficlInstruction2Dup:
+ {+ CHECK_STACK(2, 4);
+ dataTop[1] = dataTop[-1];
+ dataTop[2] = *dataTop;
+ dataTop += 2;
+ break;
+ }
+
+
+ case ficlInstructionOver:
+ {+ CHECK_STACK(2, 3);
+ dataTop[1] = dataTop[-1];
+ dataTop++;
+ break;
+ }
+
+ case ficlInstruction2Over:
+ {+ CHECK_STACK(4, 6);
+ dataTop[1] = dataTop[-3];
+ dataTop[2] = dataTop[-2];
+ dataTop += 2;
+ break;
+ }
+
+
+ case ficlInstructionPick:
+ {+ CHECK_STACK(1, 0);
+ i = dataTop->i;
+ if (i < 0)
+ break;
+ CHECK_STACK(i + 1, i + 2);
+ *dataTop = dataTop[-i];
+ break;
+ }
+
+
+ /*******************************************************************
+ ** 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)
+ break;
+
+ROLL:
+ CHECK_STACK(i+1, i+2);
+ c = dataTop[-i];
+ memmove(dataTop - i, dataTop - (i - 1), i * sizeof(ficlCell));
+ *dataTop = c;
+
+ break;
+ }
+
+ /*******************************************************************
+ ** 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)
+ break;
+
+MINUSROLL:
+ CHECK_STACK(i+1, i+2);
+ c = *dataTop;
+ memmove(dataTop - (i - 1), dataTop - i, i * sizeof(ficlCell));
+ dataTop[-i] = c;
+
+ break;
+ }
+
+
+
+ /*******************************************************************
+ ** 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;
+ break;
+ }
+
+
+ case ficlInstructionPlusStore:
+ {+ ficlCell *cell;
+ CHECK_STACK(2, 0);
+ cell = (ficlCell *)(dataTop--)->p;
+ cell->i += (dataTop--)->i;
+ break;
+ }
+
+
+ case ficlInstructionQuadFetch:
+ {+ ficlUnsigned32 *integer32;
+ CHECK_STACK(1, 1);
+ integer32 = (ficlUnsigned32 *)dataTop->i;
+ dataTop->u = (ficlUnsigned)*integer32;
+ break;
+ }
+
+ case ficlInstructionQuadStore:
+ {+ ficlUnsigned32 *integer32;
+ CHECK_STACK(2, 0);
+ integer32 = (ficlUnsigned32 *)(dataTop--)->p;
+ *integer32 = (ficlUnsigned32)((dataTop--)->u);
+ break;
+ }
+
+ case ficlInstructionWFetch:
+ {+ ficlUnsigned16 *integer16;
+ CHECK_STACK(1, 1);
+ integer16 = (ficlUnsigned16 *)dataTop->p;
+ dataTop->u = ((ficlUnsigned)*integer16);
+ break;
+ }
+
+ case ficlInstructionWStore:
+ {+ ficlUnsigned16 *integer16;
+ CHECK_STACK(2, 0);
+ integer16 = (ficlUnsigned16 *)(dataTop--)->p;
+ *integer16 = (ficlUnsigned16)((dataTop--)->u);
+ break;
+ }
+
+ case ficlInstructionCFetch:
+ {+ ficlUnsigned8 *integer8;
+ CHECK_STACK(1, 1);
+ integer8 = (ficlUnsigned8 *)dataTop->p;
+ dataTop->u = ((ficlUnsigned)*integer8);
+ break;
+ }
+
+ case ficlInstructionCStore:
+ {+ ficlUnsigned8 *integer8;
+ CHECK_STACK(2, 0);
+ integer8 = (ficlUnsigned8 *)(dataTop--)->p;
+ *integer8 = (ficlUnsigned8)((dataTop--)->u);
+ break;
+ }
+
+
+ /**************************************************************************
+ 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);
+ break;
+ }
+
+ case ficlInstruction0Less:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i = FICL_BOOL(dataTop->i < 0);
+ break;
+ }
+
+ case ficlInstruction0Greater:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i = FICL_BOOL(dataTop->i > 0);
+ break;
+ }
+
+ case ficlInstructionEquals:
+ {+ CHECK_STACK(2, 1);
+ i = (dataTop--)->i;
+ dataTop->i = FICL_BOOL(dataTop->i == i);
+ break;
+ }
+
+ case ficlInstructionLess:
+ {+ CHECK_STACK(2, 1);
+ i = (dataTop--)->i;
+ dataTop->i = FICL_BOOL(dataTop->i < i);
+ break;
+ }
+
+ case ficlInstructionULess:
+ {+ CHECK_STACK(2, 1);
+ u = (dataTop--)->u;
+ dataTop->i = FICL_BOOL(dataTop->u < u);
+ break;
+ }
+
+ case ficlInstructionAnd:
+ {+ CHECK_STACK(2, 1);
+ i = (dataTop--)->i;
+ dataTop->i = dataTop->i & i;
+ break;
+ }
+
+ case ficlInstructionOr:
+ {+ CHECK_STACK(2, 1);
+ i = (dataTop--)->i;
+ dataTop->i = dataTop->i | i;
+ break;
+ }
+
+ case ficlInstructionXor:
+ {+ CHECK_STACK(2, 1);
+ i = (dataTop--)->i;
+ dataTop->i = dataTop->i ^ i;
+ break;
+ }
+
+ case ficlInstructionInvert:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i = ~dataTop->i;
+ break;
+ }
+
+ /**************************************************************************
+ r e t u r n s t a c k
+ **
+ **************************************************************************/
+ case ficlInstructionToRStack:
+ {+ CHECK_STACK(1, 0);
+ CHECK_RETURN_STACK(0, 1);
+ *++returnTop = *dataTop--;
+ break;
+ }
+
+ case ficlInstructionFromRStack:
+ {+ CHECK_STACK(0, 1);
+ CHECK_RETURN_STACK(1, 0);
+ *++dataTop = *returnTop--;
+ break;
+ }
+
+ case ficlInstructionFetchRStack:
+ {+ CHECK_STACK(0, 1);
+ CHECK_RETURN_STACK(1, 1);
+ *++dataTop = *returnTop;
+ break;
+ }
+
+ case ficlInstruction2ToR:
+ {+ CHECK_STACK(2, 0);
+ CHECK_RETURN_STACK(0, 2);
+ *++returnTop = dataTop[-1];
+ *++returnTop = dataTop[0];
+ dataTop -= 2;
+ break;
+ }
+
+ case ficlInstruction2RFrom:
+ {+ CHECK_STACK(0, 2);
+ CHECK_RETURN_STACK(2, 0);
+ *++dataTop = returnTop[-1];
+ *++dataTop = returnTop[0];
+ returnTop -= 2;
+ break;
+ }
+
+ case ficlInstruction2RFetch:
+ {+ CHECK_STACK(0, 2);
+ CHECK_RETURN_STACK(2, 2);
+ *++dataTop = returnTop[-1];
+ *++dataTop = returnTop[0];
+ break;
+ }
+
+
+ /**************************************************************************
+ 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);
+ break;
+ }
+
+
+ /**************************************************************************
+ 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;
+ break;
+ }
+
+
+ case ficlInstructionRShift:
+ {+ ficlUnsigned nBits;
+ ficlUnsigned x1;
+ CHECK_STACK(2, 1);
+
+ nBits = (dataTop--)->u;
+ x1 = dataTop->u;
+ dataTop->u = x1 >> nBits;
+ break;
+ }
+
+
+ /**************************************************************************
+ 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);
+ break;
+ }
+
+ case ficlInstructionMin:
+ {+ ficlInteger n2;
+ ficlInteger n1;
+ CHECK_STACK(2, 1);
+
+ n2 = (dataTop--)->i;
+ n1 = dataTop->i;
+
+ dataTop->i = ((n1 < n2) ? n1 : n2);
+ break;
+ }
+
+
+ /**************************************************************************
+ 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 = (char *)(dataTop--)->p;
+ addr1 = (char *)(dataTop--)->p;
+
+ if (u == 0)
+ break;
+ /*
+ ** 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);
+ break;
+ }
+
+
+ /**************************************************************************
+ 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;
+ break;
+ }
+
+
+ /**************************************************************************
+ 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;
+ break;
+ }
+
+
+ /**************************************************************************
+ ** r a n d o m
+ ** Ficl-specific
+ **************************************************************************/
+ case ficlInstructionRandom:
+ {+ (++dataTop)->i = rand();
+ break;
+ }
+
+
+ /**************************************************************************
+ ** s e e d - r a n d o m
+ ** Ficl-specific
+ **************************************************************************/
+ case ficlInstructionSeedRandom:
+ {+ srand((dataTop--)->i);
+ break;
+ }
+
+
+
+ case ficlInstructionGreaterThan:
+ {+ ficlInteger x, y;
+ CHECK_STACK(2, 1);
+ y = (dataTop--)->i;
+ x = dataTop->i;
+ dataTop->i = FICL_BOOL(x > y);
+ break;
+ }
+
+ /**************************************************************************
+ ** 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;
+ break;
+ }
+ /* 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();
+ }
+
+ break;
+ }
+
+ 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;
+
+ break;
+ }
+
+ case ficlInstructionQDoParen:
+ {+ ficlCell index, limit, leave;
+
+ CHECK_STACK(2, 0);
+
+ index = *dataTop--;
+ limit = *dataTop--;
+
+ leave.i = *ip;
+
+ if (limit.u == index.u)
+ {+ ip = (ficlInstruction *)leave.p;
+ }
+ else
+ {+ ip++;
+ *++returnTop = leave;
+ *++returnTop = limit;
+ *++returnTop = index;
+ }
+
+ break;
+ }
+
+ 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))
+ {+ returnTop -= 3; /* nuke the loop indices & "leave" addr */
+ ip++; /* fall through the loop */
+ }
+ else
+ { /* update index, branch to loop head */+ returnTop->i = index;
+ BRANCH();
+ }
+
+ break;
+ }
+
+
+ /*
+ ** 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;
+ break;
+ }
+
+ case ficlInstructionI:
+ {+ *++dataTop = *returnTop;
+ break;
+ }
+
+
+ case ficlInstructionJ:
+ {+ *++dataTop = returnTop[-3];
+ break;
+ }
+
+
+ case ficlInstructionK:
+ {+ *++dataTop = returnTop[-6];
+ break;
+ }
+
+
+ case ficlInstructionDoesParen:
+ {+ ficlDictionary *dictionary = ficlVmGetDictionary(vm);
+ dictionary->smudge->code = (ficlPrimitive)ficlInstructionDoDoes;
+ dictionary->smudge->param[0].p = ip;
+ ip = (ficlInstruction *)((returnTop--)->p);
+ break;
+ }
+
+ 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;
+ break;
+ }
+
+#if FICL_WANT_FLOAT
+ case ficlInstructionF2Fetch:
+ CHECK_FLOAT_STACK(0, 2);
+ CHECK_STACK(1, 0);
+ FLOAT_PUSH_CELL_POINTER_DOUBLE((ficlCell *)(dataTop--)->p);
+
+ case ficlInstructionFFetch:
+ CHECK_FLOAT_STACK(0, 1);
+ CHECK_STACK(1, 0);
+ FLOAT_PUSH_CELL_POINTER((ficlCell *)(dataTop--)->p);
+
+ case ficlInstructionF2Store:
+ CHECK_FLOAT_STACK(2, 0);
+ CHECK_STACK(1, 0);
+ FLOAT_POP_CELL_POINTER_DOUBLE((ficlCell *)(dataTop--)->p);
+
+ case ficlInstructionFStore:
+ CHECK_FLOAT_STACK(1, 0);
+ CHECK_STACK(1, 0);
+ FLOAT_POP_CELL_POINTER((ficlCell *)(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((ficlCell *)(dataTop--)->p);
+
+ /*
+ ** fetch CORE ( a-addr -- x )
+ **
+ ** x is the value stored at a-addr.
+ */
+ case ficlInstructionFetch:
+ CHECK_STACK(1, 1);
+ PUSH_CELL_POINTER((ficlCell *)(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((ficlCell *)(dataTop--)->p);
+
+ /*
+ ** store CORE ( x a-addr -- )
+ ** Store x at a-addr.
+ */
+ case ficlInstructionStore:
+ CHECK_STACK(2, 0);
+ POP_CELL_POINTER((ficlCell *)(dataTop--)->p);
+
+ case ficlInstructionComma:
+ {+ ficlDictionary *dictionary;
+ CHECK_STACK(1, 0);
+
+ dictionary = ficlVmGetDictionary(vm);
+ ficlDictionaryAppendCell(dictionary, *dataTop--);
+ break;
+ }
+
+ case ficlInstructionCComma:
+ {+ ficlDictionary *dictionary;
+ char c;
+ CHECK_STACK(1, 0);
+
+ dictionary = ficlVmGetDictionary(vm);
+ c = (char)(dataTop--)->i;
+ ficlDictionaryAppendCharacter(dictionary, c);
+ break;
+ }
+
+ case ficlInstructionCells:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i *= sizeof(ficlCell);
+ break;
+ }
+
+ case ficlInstructionCellPlus:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i += sizeof(ficlCell);
+ break;
+ }
+
+ case ficlInstructionStar:
+ {+ CHECK_STACK(2, 1);
+ i = (dataTop--)->i;
+ dataTop->i *= i;
+ break;
+ }
+
+ case ficlInstructionNegate:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i = - dataTop->i;
+ break;
+ }
+
+ case ficlInstructionSlash:
+ {+ CHECK_STACK(2, 1);
+ i = (dataTop--)->i;
+ dataTop->i /= i;
+ break;
+ }
+
+ /*
+ ** 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);
+ break;
+ }
+
+
+ case ficlInstruction2Star:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i <<= 1;
+ break;
+ }
+
+ case ficlInstruction2Slash:
+ {+ CHECK_STACK(1, 1);
+ dataTop->i >>= 1;
+ break;
+ }
+
+ 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);
+ break;
+ }
+
+
+ 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);
+ break;
+ }
+
+
+#if FICL_WANT_FLOAT
+
+ case ficlInstructionF0:
+ {+ CHECK_FLOAT_STACK(0, 1);
+ (++floatTop)->f = 0.0f;
+ break;
+ }
+
+
+ case ficlInstructionF1:
+ {+ CHECK_FLOAT_STACK(0, 1);
+ (++floatTop)->f = 1.0f;
+ break;
+ }
+
+
+ case ficlInstructionFNeg1:
+ {+ CHECK_FLOAT_STACK(0, 1);
+ (++floatTop)->f = -1.0f;
+ break;
+ }
+
+
+ /*******************************************************************
+ ** 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++;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float addition r1 + r2.
+ ** f+ ( r1 r2 -- r )
+ *******************************************************************/
+ case ficlInstructionFPlus:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(2, 1);
+
+ f = (floatTop--)->f;
+ floatTop->f += f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float subtraction r1 - r2.
+ ** f- ( r1 r2 -- r )
+ *******************************************************************/
+ case ficlInstructionFMinus:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(2, 1);
+
+ f = (floatTop--)->f;
+ floatTop->f -= f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float multiplication r1 * r2.
+ ** f* ( r1 r2 -- r )
+ *******************************************************************/
+ case ficlInstructionFStar:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(2, 1);
+
+ f = (floatTop--)->f;
+ floatTop->f *= f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float negation.
+ ** fnegate ( r -- r )
+ *******************************************************************/
+ case ficlInstructionFNegate:
+ {+ CHECK_FLOAT_STACK(1, 1);
+
+ floatTop->f = -(floatTop->f);
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float division r1 / r2.
+ ** f/ ( r1 r2 -- r )
+ *******************************************************************/
+ case ficlInstructionFSlash:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(2, 1);
+
+ f = (floatTop--)->f;
+ floatTop->f /= f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float + integer r + n.
+ ** f+i ( r n -- r )
+ *******************************************************************/
+ case ficlInstructionFPlusI:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(1, 1);
+ CHECK_STACK(1, 0);
+
+ f = (ficlFloat)(dataTop--)->f;
+ floatTop->f += f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float - integer r - n.
+ ** f-i ( r n -- r )
+ *******************************************************************/
+ case ficlInstructionFMinusI:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(1, 1);
+ CHECK_STACK(1, 0);
+
+ f = (ficlFloat)(dataTop--)->f;
+ floatTop->f -= f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float * integer r * n.
+ ** f*i ( r n -- r )
+ *******************************************************************/
+ case ficlInstructionFStarI:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(1, 1);
+ CHECK_STACK(1, 0);
+
+ f = (ficlFloat)(dataTop--)->f;
+ floatTop->f *= f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float / integer r / n.
+ ** f/i ( r n -- r )
+ *******************************************************************/
+ case ficlInstructionFSlashI:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(1, 1);
+ CHECK_STACK(1, 0);
+
+ f = (ficlFloat)(dataTop--)->f;
+ floatTop->f /= f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do integer - float n - r.
+ ** i-f ( n r -- r )
+ *******************************************************************/
+ case ficlInstructionIMinusF:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(1, 1);
+ CHECK_STACK(1, 0);
+
+ f = (ficlFloat)(dataTop--)->f;
+ floatTop->f = f - floatTop->f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do integer / float n / r.
+ ** i/f ( n r -- r )
+ *******************************************************************/
+ case ficlInstructionISlashF:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(1,1);
+ CHECK_STACK(1, 0);
+
+ f = (ficlFloat)(dataTop--)->f;
+ floatTop->f = f / floatTop->f;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do integer to float conversion.
+ ** int>float ( n -- r )
+ *******************************************************************/
+ case ficlInstructionIntToFloat:
+ {+ CHECK_STACK(1, 0);
+ CHECK_FLOAT_STACK(0, 1);
+
+ (++floatTop)->f = (ficlFloat)((dataTop--)->i);
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float to integer conversion.
+ ** float>int ( r -- n )
+ *******************************************************************/
+ case ficlInstructionFloatToInt:
+ {+ CHECK_STACK(0, 1);
+ CHECK_FLOAT_STACK(1, 0);
+
+ (++dataTop)->i = (ficlInteger)((floatTop--)->f);
+ break;
+ }
+
+ /*******************************************************************
+ ** 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;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float stack drop.
+ ** fdrop ( r -- )
+ *******************************************************************/
+ case ficlInstructionFDrop:
+ {+ CHECK_FLOAT_STACK(1, 0);
+ floatTop--;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float stack ?dup.
+ ** f?dup ( r -- r )
+ *******************************************************************/
+ case ficlInstructionFQuestionDup:
+ {+ CHECK_FLOAT_STACK(1, 2);
+
+ if (floatTop->f != 0)
+ goto FDUP;
+
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float stack dup.
+ ** fdup ( r -- r r )
+ *******************************************************************/
+ case ficlInstructionFDup:
+ {+ CHECK_FLOAT_STACK(1, 2);
+
+FDUP:
+ floatTop[1] = floatTop[0];
+ floatTop++;
+ break;
+ }
+
+ /*******************************************************************
+ ** 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;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float stack 2drop.
+ ** f2drop ( r r -- )
+ *******************************************************************/
+ case ficlInstructionF2Drop:
+ {+ CHECK_FLOAT_STACK(2, 0);
+
+ floatTop -= 2;
+ break;
+ }
+
+
+ /*******************************************************************
+ ** 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;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float stack over.
+ ** fover ( r1 r2 -- r1 r2 r1 )
+ *******************************************************************/
+ case ficlInstructionFOver:
+ {+ CHECK_FLOAT_STACK(2, 3);
+
+ floatTop[1] = floatTop[-1];
+ floatTop++;
+ break;
+ }
+
+ /*******************************************************************
+ ** 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;
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float stack pick.
+ ** fpick ( n -- r )
+ *******************************************************************/
+ case ficlInstructionFPick:
+ {+ CHECK_STACK(1, 0);
+ c = *dataTop--;
+ CHECK_FLOAT_STACK(c.i+1, c.i+2);
+
+ floatTop[1] = floatTop[- c.i];
+ break;
+ }
+
+ /*******************************************************************
+ ** 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)
+ break;
+
+FROLL:
+ CHECK_FLOAT_STACK(i+1, i+2);
+ c = floatTop[-i];
+ memmove(floatTop - i, floatTop - (i - 1), i * sizeof(ficlCell));
+ *floatTop = c;
+
+ break;
+ }
+
+ /*******************************************************************
+ ** 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)
+ break;
+
+FMINUSROLL:
+ CHECK_FLOAT_STACK(i+1, i+2);
+ c = *floatTop;
+ memmove(floatTop - (i - 1), floatTop - i, i * sizeof(ficlCell));
+ floatTop[-i] = c;
+
+ break;
+ }
+
+ /*******************************************************************
+ ** 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;
+ break;
+ }
+
+ /*******************************************************************
+ ** 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);
+ break;
+ }
+
+ /*******************************************************************
+ ** 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);
+ break;
+ }
+
+ /*******************************************************************
+ ** 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);
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float = comparison r1 = r2.
+ ** f= ( r1 r2 -- T/F )
+ *******************************************************************/
+ case ficlInstructionFEquals:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(2, 0);
+ CHECK_STACK(0, 1);
+
+ f = (floatTop--)->f;
+ (++dataTop)->i = FICL_BOOL((floatTop--)->f == f);
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float < comparison r1 < r2.
+ ** f< ( r1 r2 -- T/F )
+ *******************************************************************/
+ case ficlInstructionFLess:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(2, 0);
+ CHECK_STACK(0, 1);
+
+ f = (floatTop--)->f;
+ (++dataTop)->i = FICL_BOOL((floatTop--)->f < f);
+ break;
+ }
+
+ /*******************************************************************
+ ** Do float > comparison r1 > r2.
+ ** f> ( r1 r2 -- T/F )
+ *******************************************************************/
+ case ficlInstructionFGreater:
+ {+ ficlFloat f;
+ CHECK_FLOAT_STACK(2, 0);
+ CHECK_STACK(0, 1);
+
+ f = (floatTop--)->f;
+ (++dataTop)->i = FICL_BOOL((floatTop--)->f > f);
+ break;
+ }
+
+
+ /*******************************************************************
+ ** 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--;
+ break;
+ }
+
+ case ficlInstructionToF:
+ {+ CHECK_FLOAT_STACK(0, 1);
+ CHECK_STACK(1, 0);
+
+ *++floatTop = *dataTop--;
+ break;
+ }
+
+#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);
+ break;
+ }
+
+ case ficlInstructionCreateParen:
+ {+ CHECK_STACK(0, 1);
+ (++dataTop)->p = (fw->param + 1);
+ break;
+ }
+
+ case ficlInstructionVariableParen:
+ {+ CHECK_STACK(0, 1);
+ (++dataTop)->p = fw->param;
+ break;
+ }
+
+ /**************************************************************************
+ 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];
+ break;
+ }
+#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 < ficlInstructionLast)
+ {+ instruction = (ficlInstruction)fw->code;
+ goto AGAIN;
+ }
+
+ LOCAL_VARIABLE_SPILL;
+ (vm)->runningWord = fw;
+ fw->code(vm);
+ LOCAL_VARIABLE_REFILL;
+ break;
+ }
+ }
+ }
+
+ 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);
+
+ if ((trace != stop) && isspace((unsigned char)c)) /* skip one trailing delimiter */
+ 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 */
+
+ for (c = *trace;
+ (trace != stop) && (c != delimiter)
+ && (c != '\r') && (c != '\n');
+ c = *++trace)
+ {+ ; /* find next delimiter or end of line */
+ }
+
+ /* set length of result */
+ FICL_STRING_SET_LENGTH(s, trace - FICL_STRING_GET_POINTER(s));
+
+ if ((trace != stop) && (*trace == delimiter)) /* gobble trailing 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);
+ return;
+}
+
+
+/**************************************************************************
+ v m P o p I P
+**
+**************************************************************************/
+void ficlVmPopIP(ficlVm *vm)
+{+ vm->ip = (ficlIp)(ficlStackPopPointer(vm->returnStack));
+ return;
+}
+
+
+/**************************************************************************
+ v m P u s h I P
+**
+**************************************************************************/
+void ficlVmPushIP(ficlVm *vm, ficlIp newIP)
+{+ ficlStackPushPointer(vm->returnStack, (void *)vm->ip);
+ vm->ip = newIP;
+ return;
+}
+
+
+/**************************************************************************
+ v m P u s h T i b
+** Binds the specified input string to the VM and clears >IN (the index)
+**************************************************************************/
+void 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;
+ }
+ return;
+}
+
+
+/**************************************************************************
+ 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;
+ return;
+}
+
+
+/**************************************************************************
+ 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;
+ return;
+}
+
+
+/**************************************************************************
+ v m S e t T e x t O u t
+** Binds the specified output callback to the vm. If you pass NULL,
+** binds the default output function (ficlTextOut)
+**************************************************************************/
+void ficlVmSetTextOut(ficlVm *vm, ficlOutputFunction textOut)
+{+ vm->callback.textOut = textOut;
+ return;
+}
+
+
+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");
+
+ 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");
+
+ 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;
+ vm->exceptionHandler = &vmState; /* This has to come before the setjmp! */
+ 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, (ficlWord**)&(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 ((vm->state != FICL_VM_STATE_COMPILE) && (vm->sourceId.i == 0))
+ ficlVmTextOut(vm, FICL_PROMPT);
+ 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;
+
+ default: /* unhandled exception */
+ case FICL_VM_STATUS_ERROR_EXIT:
+ ficlVmErrorOut(vm, vm->pad); /* print saved message */
+ case FICL_VM_STATUS_ABORT:
+ case FICL_VM_STATUS_ABORTQ:
+ 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;
+ vm->exceptionHandler = &vmState; /* This has to come before the setjmp! */
+ 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;
+ }
+ }
+
+ if ((length > 0) && (trace[length - 1] == '.')) /* detect & remove trailing decimal */
+ {+ 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 (isDouble) /* simple (required) DOUBLE support */
+ ficlStackPushInteger(vm->dataStack, 0);
+
+ if (isNegative)
+ accumulator = -accumulator;
+
+ ficlStackPushInteger(vm->dataStack, accumulator);
+ 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");
+ }
+
+ return;
+}
+#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");
+ }
+
+ return;
+}
+#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
+ {+ if (tempFW->flags & FICL_WORD_INSTRUCTION)
+ ficlDictionaryAppendUnsigned(dictionary, (ficlInteger)tempFW->code);
+ else
+ ficlDictionaryAppendCell(dictionary, FICL_LVALUE_TO_CELL(tempFW));
+ }
+ return 1; /* true */
+ }
+ }
+
+ return 0; /* false */
+}
+
+
--- /dev/null
+++ b/word.c
@@ -1,0 +1,144 @@
+#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 < 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;
+ }
+}
+
+
+