ref: 0618ba4a4e96ae50f32a536f73b25665970eb74e
parent: bd3b99f386d0df4011964b444da56c05eb5e3bc0
author: jsadler <jsadler@ficl.sf.net>
date: Tue Jun 12 03:24:40 CDT 2001
pSys parameter adds 64 bit changes to LVALUEtoCELL params
--- a/Makefile.linux
+++ b/Makefile.linux
@@ -1,15 +1,15 @@
-OBJECTS= dict.o ficl.o math64.o softcore.o stack.o sysdep.o vm.o words.o
+OBJECTS= dict.o ficl.o float.o math64.o prefix.o softcore.o stack.o sysdep.o tools.o unix.o vm.o words.o
HEADERS= ficl.h math64.h sysdep.h
#
# Flags for shared library
SHFLAGS = -fPIC
-CFLAGS= -O -c $(SHFLAGS)
+CFLAGS= -O -c $(SHFLAGS) -Dlinux
CC=gcc
LIB = ar cr
RANLIB = ranlib
-MAJOR = 2
-MINOR = 0.3
+MAJOR = 3
+MINOR = 0.0
lib: libficl.so.$(MAJOR).$(MINOR)
--- a/Makefile.riscos
+++ b/Makefile.riscos
@@ -6,8 +6,8 @@
CC=gcc
LIB = makealf -qls -o
-MAJOR = 2
-MINOR = 0.3
+MAJOR = 3
+MINOR = 0.0
lib: o.libficl
--- a/ReadMe.txt
+++ b/ReadMe.txt
@@ -1,3 +1,26 @@
+rel 3.00 -- June 2001
+
+- Added pSys parameter to most ficlXXXX functions - multiple system support
+ dictLookupLoc renamed to ficlLookupLoc after addition of pSys param
+ ficlInitSystem returns a FICL_SYSTEM*
+ ficlTermSystem
+ ficlNewVM
+ ficlLookup
+ ficlGetDict
+ ficlGetEnv
+ ficlSetEnv
+ ficlSetEnvD
+ ficlGetLoc
+ ficlBuild
+
+- Fixed off-by-one bug in ficlParsePrefix
+- Ficl parse-steps now work correctly - mods to interpret()
+- Made tools.c:isAFiclWord more selective
+- Tweaked makefiles and code to make gcc happy under linux
+- Vetted all instances of LVALUEtoCELL to make sure they're working on CELL sized operands
+ (for 64 bit compatibility)
+- Doc updates
+
rel 2.06 -- May 2001 (feast or famine around here)
- Debugger changes:
--- a/dict.c
+++ b/dict.c
@@ -3,7 +3,7 @@
** Forth Inspired Command Language - dictionary methods
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 19 July 1997
-** $Id: dict.c,v 1.10 2001/05/17 13:51:25 jsadler Exp $
+** $Id: dict.c,v 1.11 2001/06/12 08:24:31 jsadler Exp $
*******************************************************************/
/*
** This file implements the dictionary -- FICL's model of
@@ -461,7 +461,7 @@
**************************************************************************/
void dictHashSummary(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
FICL_HASH *pFHash;
FICL_WORD **pHash;
unsigned size;
@@ -566,15 +566,16 @@
/**************************************************************************
- d i c t L o o k u p L o c
+ f i c l L o o k u p L o c
** Same as dictLookup, but looks in system locals dictionary first...
** Assumes locals dictionary has only one wordlist...
**************************************************************************/
#if FICL_WANT_LOCALS
-FICL_WORD *dictLookupLoc(FICL_DICT *pDict, STRINGINFO si)
+FICL_WORD *ficlLookupLoc(FICL_SYSTEM *pSys, STRINGINFO si)
{FICL_WORD *pFW = NULL;
- FICL_HASH *pHash = ficlGetLoc()->pForthWords;
+ FICL_DICT *pDict = pSys->dp;
+ FICL_HASH *pHash = ficlGetLoc(pSys)->pForthWords;
int i;
UNS16 hashCode = hashHashCode(si);
--- a/ficl.c
+++ b/ficl.c
@@ -3,7 +3,7 @@
** Forth Inspired Command Language - external interface
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 19 July 1997
-** $Id: ficl.c,v 1.12 2001/05/13 04:59:14 jsadler Exp $
+** $Id: ficl.c,v 1.13 2001/06/12 08:24:38 jsadler Exp $
*******************************************************************/
/*
** This is an ANS Forth interpreter written in C.
@@ -71,8 +71,6 @@
** but you can insert one: #define FICL_MULTITHREAD 1
** and supply your own version of ficlLockDictionary.
*/
-static FICL_SYSTEM *pSys = NULL;
-
static int defaultStack = FICL_DEFAULT_STACK;
static int defaultDict = FICL_DEFAULT_DICT;
@@ -88,9 +86,9 @@
** precompiled part. Try 1K cells minimum. Use "words" to find
** out how much of the dictionary is used at any time.
**************************************************************************/
-void ficlInitSystem(int nDictCells)
+FICL_SYSTEM *ficlInitSystem(int nDictCells)
{- pSys = ficlMalloc(sizeof (FICL_SYSTEM));
+ FICL_SYSTEM *pSys = ficlMalloc(sizeof (FICL_SYSTEM));
assert(pSys);
memset(pSys, 0, sizeof (FICL_SYSTEM));
@@ -109,7 +107,7 @@
** The locals dictionary is only searched while compiling,
** but this is where speed is most important. On the other
** hand, the dictionary gets emptied after each use of locals
- ** The need to balance search speed with the cost of the empty
+ ** The need to balance search speed with the cost of the 'empty'
** operation led me to select a single-threaded list...
*/
pSys->localp = dictCreate((unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD);
@@ -117,8 +115,8 @@
/*
** Establish the parse order. Note that prefixes precede numbers -
- ** this allows constructs like "0b101010" which would parse as a
- ** valid hex value otherwise.
+ ** this allows constructs like "0b101010" which might parse as a
+ ** hex value otherwise.
*/
ficlCompilePrefix(pSys);
ficlAddPrecompiledParseStep(pSys, "?number", ficlParseNumber);
@@ -138,17 +136,19 @@
#endif
/*
- ** Now we can create a VM to compile the softwords. Note that the VM initialization
- ** code needs to be able to find "interpret" in the dictionary in order to
- ** succeed, so as presently constructed ficlCompileCore has to finish before
- ** a VM can be created successfully.
+ ** Now create a temporary VM to compile the softwords. Since all VMs are
+ ** linked into the vmList of FICL_SYSTEM, we don't have to pass the VM
+ ** to ficlCompileSoftCore -- it just hijacks whatever it finds in the VM list.
+ ** ficl 2.05: vmCreate no longer depends on the presence of INTERPRET in the
+ ** dictionary, so a VM can be created before the dictionary is built. It just
+ ** can't do much...
*/
- ficlNewVM();
+ ficlNewVM(pSys);
ficlCompileSoftCore(pSys);
ficlFreeVM(pSys->vmList);
- return;
+ return pSys;
}
@@ -218,7 +218,7 @@
** Create a new virtual machine and link it into the system list
** of VMs for later cleanup by ficlTermSystem.
**************************************************************************/
-FICL_VM *ficlNewVM(void)
+FICL_VM *ficlNewVM(FICL_SYSTEM *pSys)
{FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack);
pVM->link = pSys->vmList;
@@ -238,6 +238,7 @@
**************************************************************************/
void ficlFreeVM(FICL_VM *pVM)
{+ FICL_SYSTEM *pSys = pVM->pSys;
FICL_VM *pList = pSys->vmList;
assert(pVM != 0);
@@ -276,7 +277,7 @@
** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR!
**
**************************************************************************/
-int ficlBuild(char *name, FICL_CODE code, char flags)
+int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags)
{int err = ficlLockDictionary(TRUE);
if (err) return err;
@@ -314,6 +315,7 @@
int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
{+ FICL_SYSTEM *pSys = pVM->pSys;
FICL_WORD **pInterp = pSys->pInterp;
FICL_DICT *dp = pSys->dp;
@@ -324,8 +326,8 @@
if (!pInterp[0])
{- pInterp[0] = ficlLookup("interpret");- pInterp[1] = ficlLookup("(branch)");+ pInterp[0] = ficlLookup(pSys, "interpret");
+ pInterp[1] = ficlLookup(pSys, "(branch)");
pInterp[2] = (FICL_WORD *)(void *)(-2);
}
@@ -435,7 +437,7 @@
FICL_WORD *oldRunningWord;
if (!pQuit)
- pQuit = ficlLookup("exit-inner");+ pQuit = ficlLookup(pVM->pSys, "exit-inner");
assert(pVM);
assert(pQuit);
@@ -496,7 +498,7 @@
** found, return the address of the corresponding FICL_WORD. Otherwise
** return NULL.
**************************************************************************/
-FICL_WORD *ficlLookup(char *name)
+FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name)
{STRINGINFO si;
SI_PSZ(si, name);
@@ -508,7 +510,7 @@
f i c l G e t D i c t
** Returns the address of the system dictionary
**************************************************************************/
-FICL_DICT *ficlGetDict(void)
+FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys)
{return pSys->dp;
}
@@ -518,7 +520,7 @@
f i c l G e t E n v
** Returns the address of the system environment space
**************************************************************************/
-FICL_DICT *ficlGetEnv(void)
+FICL_DICT *ficlGetEnv(FICL_SYSTEM *pSys)
{return pSys->envp;
}
@@ -529,7 +531,7 @@
** Create an environment variable with a one-CELL payload. ficlSetEnvD
** makes one with a two-CELL payload.
**************************************************************************/
-void ficlSetEnv(char *name, FICL_UNS value)
+void ficlSetEnv(FICL_SYSTEM *pSys, char *name, FICL_UNS value)
{STRINGINFO si;
FICL_WORD *pFW;
@@ -551,7 +553,7 @@
return;
}
-void ficlSetEnvD(char *name, FICL_UNS hi, FICL_UNS lo)
+void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo)
{FICL_WORD *pFW;
STRINGINFO si;
@@ -581,7 +583,7 @@
** only used during compilation, and is shared by all VMs.
**************************************************************************/
#if FICL_WANT_LOCALS
-FICL_DICT *ficlGetLoc(void)
+FICL_DICT *ficlGetLoc(FICL_SYSTEM *pSys)
{return pSys->localp;
}
@@ -610,7 +612,7 @@
** Tear the system down by deleting the dictionaries and all VMs.
** This saves you from having to keep track of all that stuff.
**************************************************************************/
-void ficlTermSystem(void)
+void ficlTermSystem(FICL_SYSTEM *pSys)
{if (pSys->dp)
dictDelete(pSys->dp);
--- a/ficl.dsp
+++ b/ficl.dsp
@@ -245,6 +245,10 @@
# End Source File
# Begin Source File
+SOURCE=.\doc\ficl_parse.html
+# End Source File
+# Begin Source File
+
SOURCE=.\doc\ficl_rel.html
# End Source File
# Begin Source File
--- a/ficl.h
+++ b/ficl.h
@@ -3,7 +3,8 @@
** Forth Inspired Command Language
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 19 July 1997
-** $Id: ficl.h,v 1.14 2001/05/17 13:51:27 jsadler Exp $
+** Dedicated to RHS, in loving memory
+** $Id: ficl.h,v 1.15 2001/06/12 08:24:33 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -131,7 +132,7 @@
** F o r M o r e I n f o r m a t i o n
**
** Web home of ficl
-** http://www.taygeta.com/forth/compilers
+** http://ficl.sourceforge.net
** Check this website for Forth literature (including the ANSI standard)
** http://www.taygeta.com/forthlit.html
** and here for software and more links
@@ -224,8 +225,11 @@
** Forward declarations... read on.
*/
struct ficl_word;
+typedef struct ficl_word FICL_WORD;
struct vm;
+typedef struct vm FICL_VM;
struct ficl_dict;
+typedef struct ficl_dict FICL_DICT;
struct ficl_system;
typedef struct ficl_system FICL_SYSTEM;
@@ -232,7 +236,7 @@
/*
** the Good Stuff starts here...
*/
-#define FICL_VER "2.06"
+#define FICL_VER "3.00"
#if !defined (FICL_PROMPT)
#define FICL_PROMPT "ok> "
#endif
@@ -264,7 +268,7 @@
} CELL;
/*
-** LVALUEtoCELL does a little pointer trickery to cast any 32 bit
+** LVALUEtoCELL does a little pointer trickery to cast any CELL sized
** lvalue (informal definition: an expression whose result has an
** address) to CELL. Remember that constants and casts are NOT
** themselves lvalues!
@@ -359,59 +363,59 @@
/*
** Stack methods... many map closely to required Forth words.
*/
-FICL_STACK *stackCreate(unsigned nCells);
-void stackDelete(FICL_STACK *pStack);
-int stackDepth (FICL_STACK *pStack);
-void stackDrop (FICL_STACK *pStack, int n);
-CELL stackFetch (FICL_STACK *pStack, int n);
-CELL stackGetTop(FICL_STACK *pStack);
-void stackLink (FICL_STACK *pStack, int nCells);
-void stackPick (FICL_STACK *pStack, int n);
-CELL stackPop (FICL_STACK *pStack);
-void *stackPopPtr(FICL_STACK *pStack);
-FICL_UNS stackPopUNS(FICL_STACK *pStack);
-FICL_INT stackPopINT(FICL_STACK *pStack);
-void stackPush (FICL_STACK *pStack, CELL c);
+FICL_STACK *stackCreate (unsigned nCells);
+void stackDelete (FICL_STACK *pStack);
+int stackDepth (FICL_STACK *pStack);
+void stackDrop (FICL_STACK *pStack, int n);
+CELL stackFetch (FICL_STACK *pStack, int n);
+CELL stackGetTop (FICL_STACK *pStack);
+void stackLink (FICL_STACK *pStack, int nCells);
+void stackPick (FICL_STACK *pStack, int n);
+CELL stackPop (FICL_STACK *pStack);
+void *stackPopPtr (FICL_STACK *pStack);
+FICL_UNS stackPopUNS (FICL_STACK *pStack);
+FICL_INT stackPopINT (FICL_STACK *pStack);
+void stackPush (FICL_STACK *pStack, CELL c);
void stackPushPtr (FICL_STACK *pStack, void *ptr);
-void stackPushUNS(FICL_STACK *pStack, FICL_UNS u);
-void stackPushINT(FICL_STACK *pStack, FICL_INT i);
-void stackReset (FICL_STACK *pStack);
-void stackRoll (FICL_STACK *pStack, int n);
-void stackSetTop(FICL_STACK *pStack, CELL c);
-void stackStore (FICL_STACK *pStack, int n, CELL c);
-void stackUnlink(FICL_STACK *pStack);
+void stackPushUNS (FICL_STACK *pStack, FICL_UNS u);
+void stackPushINT (FICL_STACK *pStack, FICL_INT i);
+void stackReset (FICL_STACK *pStack);
+void stackRoll (FICL_STACK *pStack, int n);
+void stackSetTop (FICL_STACK *pStack, CELL c);
+void stackStore (FICL_STACK *pStack, int n, CELL c);
+void stackUnlink (FICL_STACK *pStack);
#if (FICL_WANT_FLOAT)
float stackPopFloat (FICL_STACK *pStack);
-void stackPushFloat(FICL_STACK *pStack, float f);
+void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f);
#endif
/*
** Shortcuts (Guy Carver)
*/
-#define PUSHPTR(p) stackPushPtr(pVM->pStack,p)
-#define PUSHUNS(u) stackPushUNS(pVM->pStack,u)
-#define PUSHINT(i) stackPushINT(pVM->pStack,i)
-#define PUSHFLOAT(f) stackPushFloat(pVM->fStack,f)
-#define PUSH(c) stackPush(pVM->pStack,c)
-#define POPPTR() stackPopPtr(pVM->pStack)
-#define POPUNS() stackPopUNS(pVM->pStack)
-#define POPINT() stackPopINT(pVM->pStack)
-#define POPFLOAT() stackPopFloat(pVM->fStack)
-#define POP() stackPop(pVM->pStack)
-#define GETTOP() stackGetTop(pVM->pStack)
-#define SETTOP(c) stackSetTop(pVM->pStack,LVALUEtoCELL(c))
-#define GETTOPF() stackGetTop(pVM->fStack)
-#define SETTOPF(c) stackSetTop(pVM->fStack,LVALUEtoCELL(c))
-#define STORE(n,c) stackStore(pVM->pStack,n,LVALUEtoCELL(c))
-#define DEPTH() stackDepth(pVM->pStack)
-#define DROP(n) stackDrop(pVM->pStack,n)
-#define DROPF(n) stackDrop(pVM->fStack,n)
-#define FETCH(n) stackFetch(pVM->pStack,n)
-#define PICK(n) stackPick(pVM->pStack,n)
-#define PICKF(n) stackPick(pVM->fStack,n)
-#define ROLL(n) stackRoll(pVM->pStack,n)
-#define ROLLF(n) stackRoll(pVM->fStack,n)
+#define PUSHPTR(p) stackPushPtr(pVM->pStack,p)
+#define PUSHUNS(u) stackPushUNS(pVM->pStack,u)
+#define PUSHINT(i) stackPushINT(pVM->pStack,i)
+#define PUSHFLOAT(f) stackPushFloat(pVM->fStack,f)
+#define PUSH(c) stackPush(pVM->pStack,c)
+#define POPPTR() stackPopPtr(pVM->pStack)
+#define POPUNS() stackPopUNS(pVM->pStack)
+#define POPINT() stackPopINT(pVM->pStack)
+#define POPFLOAT() stackPopFloat(pVM->fStack)
+#define POP() stackPop(pVM->pStack)
+#define GETTOP() stackGetTop(pVM->pStack)
+#define SETTOP(c) stackSetTop(pVM->pStack,LVALUEtoCELL(c))
+#define GETTOPF() stackGetTop(pVM->fStack)
+#define SETTOPF(c) stackSetTop(pVM->fStack,LVALUEtoCELL(c))
+#define STORE(n,c) stackStore(pVM->pStack,n,LVALUEtoCELL(c))
+#define DEPTH() stackDepth(pVM->pStack)
+#define DROP(n) stackDrop(pVM->pStack,n)
+#define DROPF(n) stackDrop(pVM->fStack,n)
+#define FETCH(n) stackFetch(pVM->pStack,n)
+#define PICK(n) stackPick(pVM->pStack,n)
+#define PICKF(n) stackPick(pVM->fStack,n)
+#define ROLL(n) stackRoll(pVM->pStack,n)
+#define ROLLF(n) stackRoll(pVM->fStack,n)
/*
** The virtual machine (VM) contains the state for one interpreter.
@@ -425,7 +429,7 @@
** Throw an exception
*/
-typedef struct ficl_word ** IPTYPE; /* the VM's instruction pointer */
+typedef FICL_WORD ** IPTYPE; /* the VM's instruction pointer */
/*
** Each VM has a placeholder for an output function -
@@ -433,7 +437,7 @@
** through a different device. If you specify no
** OUTFUNC, it defaults to ficlTextOut.
*/
-typedef void (*OUTFUNC)(struct vm *pVM, char *text, int fNewline);
+typedef void (*OUTFUNC)(FICL_VM *pVM, char *text, int fNewline);
/*
** Each VM operates in one of two non-error states: interpreting
@@ -464,17 +468,16 @@
/*
** OK - now we can really define the VM...
*/
-typedef struct vm
+struct vm
{FICL_SYSTEM *pSys; /* Which system this VM belongs to */
- struct vm *link; /* Ficl keeps a VM list for simple teardown */
+ FICL_VM *link; /* Ficl keeps a VM list for simple teardown */
jmp_buf *pState; /* crude exception mechanism... */
OUTFUNC textOut; /* Output callback - see sysdep.c */
void * pExtend; /* vm extension pointer */
short fRestart; /* Set TRUE to restart runningWord */
IPTYPE ip; /* instruction pointer */
- struct ficl_word
- *runningWord;/* address of currently running word (often just *(ip-1) ) */
+ FICL_WORD *runningWord;/* address of currently running word (often just *(ip-1) ) */
FICL_UNS state; /* compiling or interpreting */
FICL_UNS base; /* number conversion base */
FICL_STACK *pStack; /* param stack */
@@ -488,7 +491,7 @@
CELL user[FICL_USER_CELLS];
#endif
char pad[nPAD]; /* the scratch area (see above) */
-} FICL_VM;
+};
/*
** A FICL_CODE points to a function that gets called to help execute
@@ -514,10 +517,10 @@
** words in a linked list called the dictionary.
** A FICL_WORD starts each entry in the list.
** Version 1.02: space for the name characters is allotted from
-** the dictionary ahead of the word struct - this saves about half
-** the storage on average with very little runtime cost.
+** the dictionary ahead of the word struct, rather than using
+** a fixed size array for each name.
*/
-typedef struct ficl_word
+struct ficl_word
{struct ficl_word *link; /* Previous word in the dictionary */
UNS16 hash;
@@ -526,7 +529,7 @@
char *name; /* First nFICLNAME chars of word name */
FICL_CODE code; /* Native code to execute the word */
CELL param[1]; /* First data cell of the word */
-} FICL_WORD;
+};
/*
** Worst-case size of a word header: nFICLNAME chars in name
@@ -562,28 +565,29 @@
void vmBranchRelative(FICL_VM *pVM, int offset);
-FICL_VM * vmCreate (FICL_VM *pVM, unsigned nPStack, unsigned nRStack);
-void vmDelete (FICL_VM *pVM);
-void vmExecute(FICL_VM *pVM, FICL_WORD *pWord);
-char * vmGetString(FICL_VM *pVM, FICL_STRING *spDest, char delimiter);
-STRINGINFO vmGetWord(FICL_VM *pVM);
-STRINGINFO vmGetWord0(FICL_VM *pVM);
-int vmGetWordToPad(FICL_VM *pVM);
-STRINGINFO vmParseString(FICL_VM *pVM, char delimiter);
+FICL_VM * vmCreate (FICL_VM *pVM, unsigned nPStack, unsigned nRStack);
+void vmDelete (FICL_VM *pVM);
+void vmExecute (FICL_VM *pVM, FICL_WORD *pWord);
+FICL_DICT *vmGetDict (FICL_VM *pVM);
+char * vmGetString (FICL_VM *pVM, FICL_STRING *spDest, char delimiter);
+STRINGINFO vmGetWord (FICL_VM *pVM);
+STRINGINFO vmGetWord0 (FICL_VM *pVM);
+int vmGetWordToPad (FICL_VM *pVM);
+STRINGINFO vmParseString (FICL_VM *pVM, char delimiter);
STRINGINFO vmParseStringEx(FICL_VM *pVM, char delimiter, char fSkipLeading);
-CELL vmPop(FICL_VM *pVM);
-void vmPush(FICL_VM *pVM, CELL c);
-void vmPopIP (FICL_VM *pVM);
-void vmPushIP (FICL_VM *pVM, IPTYPE newIP);
-void vmQuit (FICL_VM *pVM);
-void vmReset (FICL_VM *pVM);
-void vmSetTextOut(FICL_VM *pVM, OUTFUNC textOut);
+CELL vmPop (FICL_VM *pVM);
+void vmPush (FICL_VM *pVM, CELL c);
+void vmPopIP (FICL_VM *pVM);
+void vmPushIP (FICL_VM *pVM, IPTYPE newIP);
+void vmQuit (FICL_VM *pVM);
+void vmReset (FICL_VM *pVM);
+void vmSetTextOut (FICL_VM *pVM, OUTFUNC textOut);
#if FICL_WANT_DEBUGGER
-void vmStep(FICL_VM *pVM);
+void vmStep (FICL_VM *pVM);
#endif
-void vmTextOut(FICL_VM *pVM, char *text, int fNewline);
-void vmThrow (FICL_VM *pVM, int except);
-void vmThrowErr(FICL_VM *pVM, char *fmt, ...);
+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)
@@ -628,11 +632,11 @@
** PopTib restores the TIB state given a saved TIB from PushTib
** GetInBuf returns a pointer to the next unused char of the TIB
*/
-void vmPushTib(FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib);
-void vmPopTib(FICL_VM *pVM, TIB *pTib);
-#define vmGetInBuf(pVM) ((pVM)->tib.cp + (pVM)->tib.index)
-#define vmGetInBufLen(pVM) ((pVM)->tib.end - (pVM)->tib.cp)
-#define vmGetInBufEnd(pVM) ((pVM)->tib.end)
+void vmPushTib (FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib);
+void vmPopTib (FICL_VM *pVM, TIB *pTib);
+#define vmGetInBuf(pVM) ((pVM)->tib.cp + (pVM)->tib.index)
+#define vmGetInBufLen(pVM) ((pVM)->tib.end - (pVM)->tib.cp)
+#define vmGetInBufEnd(pVM) ((pVM)->tib.end)
#define vmGetTibIndex(pVM) (pVM)->tib.index
#define vmSetTibIndex(pVM, i) (pVM)->tib.index = i
#define vmUpdateTib(pVM, str) (pVM)->tib.index = (str) - (pVM)->tib.cp
@@ -682,13 +686,11 @@
FICL_WORD *table[1];
} FICL_HASH;
-void hashForget(FICL_HASH *pHash, void *where);
-UNS16 hashHashCode(STRINGINFO si);
+void hashForget (FICL_HASH *pHash, void *where);
+UNS16 hashHashCode (STRINGINFO si);
void hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW);
-FICL_WORD *hashLookup(struct ficl_hash *pHash,
- STRINGINFO si,
- UNS16 hashCode);
-void hashReset(FICL_HASH *pHash);
+FICL_WORD *hashLookup (FICL_HASH *pHash, STRINGINFO si, UNS16 hashCode);
+void hashReset (FICL_HASH *pHash);
/*
** A Dictionary is a linked list of FICL_WORDs. It is also Ficl's
@@ -721,7 +723,7 @@
** size -- number of cells in the dictionary (total)
** dict -- start of data area. Must be at the end of the struct.
*/
-typedef struct ficl_dict
+struct ficl_dict
{CELL *here;
FICL_WORD *smudge;
@@ -731,16 +733,16 @@
int nLists;
unsigned size; /* Number of cells in dict (total)*/
CELL dict[1]; /* Base of dictionary memory */
-} FICL_DICT;
+};
void *alignPtr(void *ptr);
void dictAbortDefinition(FICL_DICT *pDict);
-void dictAlign(FICL_DICT *pDict);
-int dictAllot(FICL_DICT *pDict, int n);
-int dictAllotCells(FICL_DICT *pDict, int nCells);
-void dictAppendCell(FICL_DICT *pDict, CELL c);
-void dictAppendChar(FICL_DICT *pDict, char c);
-FICL_WORD *dictAppendWord(FICL_DICT *pDict,
+void dictAlign (FICL_DICT *pDict);
+int dictAllot (FICL_DICT *pDict, int n);
+int dictAllotCells (FICL_DICT *pDict, int nCells);
+void dictAppendCell (FICL_DICT *pDict, CELL c);
+void dictAppendChar (FICL_DICT *pDict, char c);
+FICL_WORD *dictAppendWord (FICL_DICT *pDict,
char *name,
FICL_CODE pCode,
UNS8 flags);
@@ -748,26 +750,26 @@
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);
+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);
+void dictDelete (FICL_DICT *pDict);
+void dictEmpty (FICL_DICT *pDict, unsigned nHash);
void dictHashSummary(FICL_VM *pVM);
-int dictIncludes(FICL_DICT *pDict, void *p);
-FICL_WORD *dictLookup(FICL_DICT *pDict, STRINGINFO si);
+int dictIncludes (FICL_DICT *pDict, void *p);
+FICL_WORD *dictLookup (FICL_DICT *pDict, STRINGINFO si);
#if FICL_WANT_LOCALS
-FICL_WORD *dictLookupLoc(FICL_DICT *pDict, STRINGINFO si);
+FICL_WORD *ficlLookupLoc (FICL_SYSTEM *pSys, STRINGINFO si);
#endif
void dictResetSearchOrder(FICL_DICT *pDict);
-void dictSetFlags(FICL_DICT *pDict, UNS8 set, UNS8 clr);
+void dictSetFlags (FICL_DICT *pDict, UNS8 set, UNS8 clr);
void dictSetImmediate(FICL_DICT *pDict);
-void dictUnsmudge(FICL_DICT *pDict);
-CELL *dictWhere(FICL_DICT *pDict);
+void dictUnsmudge (FICL_DICT *pDict);
+CELL *dictWhere (FICL_DICT *pDict);
/*
@@ -818,7 +820,7 @@
** not a problem provided the precompiled dictionaries are identical for
** all systems.
*/
-typedef struct ficl_system
+struct ficl_system
{FICL_SYSTEM *link;
FICL_VM *vmList;
@@ -829,7 +831,7 @@
#endif
FICL_WORD *pInterp[3];
FICL_WORD *parseList[FICL_MAX_PARSE_STEPS];
-} FICL_SYSTEM;
+};
/*
** External interface to FICL...
@@ -846,7 +848,7 @@
** precompiled part. Try 1K cells minimum. Use "words" to find
** out how much of the dictionary is used at any time.
*/
-void ficlInitSystem(int nDictCells);
+FICL_SYSTEM *ficlInitSystem(int nDictCells);
/*
** f i c l T e r m S y s t e m
@@ -854,7 +856,7 @@
** were created with ficlNewVM (see below). Call this function to
** reclaim all memory used by the dictionary and VMs.
*/
-void ficlTermSystem(void);
+void ficlTermSystem(FICL_SYSTEM *pSys);
/*
** f i c l E x e c
@@ -888,7 +890,7 @@
** address of the VM, or NULL if an error occurs.
** Precondition: successful execution of ficlInitSystem
*/
-FICL_VM *ficlNewVM(void);
+FICL_VM *ficlNewVM(FICL_SYSTEM *pSys);
/*
** Force deletion of a VM. You do not need to do this
@@ -911,7 +913,7 @@
** dictionary with the given name, or NULL if no match.
** Precondition: successful execution of ficlInitSystem
*/
-FICL_WORD *ficlLookup(char *name);
+FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name);
/*
** f i c l G e t D i c t
@@ -918,12 +920,12 @@
** Utility function - returns the address of the system dictionary.
** Precondition: successful execution of ficlInitSystem
*/
-FICL_DICT *ficlGetDict(void);
-FICL_DICT *ficlGetEnv(void);
-void ficlSetEnv(char *name, FICL_UNS value);
-void ficlSetEnvD(char *name, FICL_UNS hi, FICL_UNS lo);
+FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys);
+FICL_DICT *ficlGetEnv (FICL_SYSTEM *pSys);
+void ficlSetEnv (FICL_SYSTEM *pSys, char *name, FICL_UNS value);
+void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo);
#if FICL_WANT_LOCALS
-FICL_DICT *ficlGetLoc(void);
+FICL_DICT *ficlGetLoc (FICL_SYSTEM *pSys);
#endif
/*
** f i c l B u i l d
@@ -941,7 +943,7 @@
** Most words can use FW_DEFAULT.
** nAllot - number of extra cells to allocate in the parameter area (usually zero)
*/
-int ficlBuild(char *name, FICL_CODE code, char flags);
+int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags);
/*
** f i c l C o m p i l e C o r e
@@ -972,7 +974,7 @@
/*
** From tools.c
*/
-int isAFiclWord(FICL_WORD *pFW);
+int isAFiclWord(FICL_DICT *pd, FICL_WORD *pFW);
/*
** The following supports SEE and the debugger.
--- a/float.c
+++ b/float.c
@@ -4,7 +4,7 @@
** ANS Forth FLOAT word-set written in C
** Author: Guy Carver & John Sadler (john_sadler@alum.mit.edu)
** Created: Apr 2001
-** $Id: float.c,v 1.3 2001/05/13 04:59:07 jsadler Exp $
+** $Id: float.c,v 1.4 2001/06/12 08:24:34 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -56,7 +56,7 @@
*******************************************************************/
static void Fadd(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 2, 1);
@@ -72,7 +72,7 @@
*******************************************************************/
static void Fsub(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 2, 1);
@@ -89,7 +89,7 @@
*******************************************************************/
static void Fmul(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 2, 1);
@@ -105,7 +105,7 @@
*******************************************************************/
static void Fnegate(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 1, 1);
@@ -121,7 +121,7 @@
*******************************************************************/
static void Fdiv(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 2, 1);
@@ -138,7 +138,7 @@
*******************************************************************/
static void Faddi(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 1, 1);
@@ -145,7 +145,7 @@
vmCheckStack(pVM, 1, 0);
#endif
- f = (float)POPINT() + GETTOPF().f;
+ f = (FICL_FLOAT)POPINT() + GETTOPF().f;
SETTOPF(f);
}
@@ -155,7 +155,7 @@
*******************************************************************/
static void Fsubi(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 1, 1);
@@ -162,7 +162,7 @@
vmCheckStack(pVM, 1, 0);
#endif
- f = GETTOPF().f - (float)POPINT();
+ f = GETTOPF().f - (FICL_FLOAT)POPINT();
SETTOPF(f);
}
@@ -172,7 +172,7 @@
*******************************************************************/
static void Fmuli(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 1, 1);
@@ -179,7 +179,7 @@
vmCheckStack(pVM, 1, 0);
#endif
- f = (float)POPINT() * GETTOPF().f;
+ f = (FICL_FLOAT)POPINT() * GETTOPF().f;
SETTOPF(f);
}
@@ -189,7 +189,7 @@
*******************************************************************/
static void Fdivi(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 1, 1);
@@ -196,7 +196,7 @@
vmCheckStack(pVM, 1, 0);
#endif
- f = GETTOPF().f / (float)POPINT();
+ f = GETTOPF().f / (FICL_FLOAT)POPINT();
SETTOPF(f);
}
@@ -206,7 +206,7 @@
*******************************************************************/
static void isubf(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 1, 1);
@@ -213,7 +213,7 @@
vmCheckStack(pVM, 1, 0);
#endif
- f = (float)POPINT() - GETTOPF().f;
+ f = (FICL_FLOAT)POPINT() - GETTOPF().f;
SETTOPF(f);
}
@@ -223,7 +223,7 @@
*******************************************************************/
static void idivf(FICL_VM *pVM)
{- float f;
+ FICL_FLOAT f;
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 1,1);
@@ -230,7 +230,7 @@
vmCheckStack(pVM, 1, 0);
#endif
- f = (float)POPINT() / GETTOPF().f;
+ f = (FICL_FLOAT)POPINT() / GETTOPF().f;
SETTOPF(f);
}
@@ -288,7 +288,7 @@
*******************************************************************/
static void Fconstant(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
STRINGINFO si = vmGetWord(pVM);
#if FICL_ROBUST > 1
@@ -648,8 +648,8 @@
*******************************************************************/
static void fliteralIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
- FICL_WORD *pfLitParen = ficlLookup("(fliteral)");+ FICL_DICT *dp = vmGetDict(pVM);
+ FICL_WORD *pfLitParen = ficlLookup(pVM->pSys, "(fliteral)");
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 1, 0);
@@ -806,7 +806,7 @@
#define NUMISNEG 1
#define EXPISNEG 2
-enum
+enum _floatParseState
{FPS_START,
FPS_ININT,
@@ -1031,9 +1031,9 @@
dictAppendWord(dp, "f-rot", Fminusrot, FW_DEFAULT);
dictAppendWord(dp, "(fliteral)", fliteralParen, FW_COMPILE);
- ficlSetEnv("floating", FICL_FALSE); /* not all required words are present */- ficlSetEnv("floating-ext", FICL_FALSE);- ficlSetEnv("floating-stack", FICL_DEFAULT_STACK);+ ficlSetEnv(pSys, "floating", FICL_FALSE); /* not all required words are present */
+ ficlSetEnv(pSys, "floating-ext", FICL_FALSE);
+ ficlSetEnv(pSys, "floating-stack", FICL_DEFAULT_STACK);
ficlAddPrecompiledParseStep(pSys, ">float", ficlParseFloatNumber);
#endif
--- a/prefix.c
+++ b/prefix.c
@@ -4,7 +4,7 @@
** Parser extensions for Ficl
** Authors: Larry Hastings & John Sadler (john_sadler@alum.mit.edu)
** Created: April 2001
-** $Id: prefix.c,v 1.2 2001/05/10 14:47:35 jsadler Exp $
+** $Id: prefix.c,v 1.3 2001/06/12 08:24:38 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -72,7 +72,7 @@
{int i;
FICL_HASH *pHash;
- FICL_WORD *pFW = ficlLookup(list_name);
+ FICL_WORD *pFW = ficlLookup(pVM->pSys, list_name);
assert(pFW);
pHash = (FICL_HASH *)(pFW->param[0].p);
@@ -92,7 +92,8 @@
*/
if (!strincmp(SI_PTR(si), pFW->name, (FICL_UNS)n))
{- vmSetTibIndex(pVM, vmGetTibIndex(pVM) - 1 - SI_COUNT(si) + n);
+ /* (sadler) fixed off-by-one error when the token has no trailing space in the TIB */
+ vmSetTibIndex(pVM, si.cp + n - pVM->tib.cp );
vmExecute(pVM, pFW);
return FICL_TRUE;
@@ -114,7 +115,7 @@
if (!ficlParseNumber(pVM, si))
{int i = SI_COUNT(si);
- vmThrowErr(pVM, "0x%.*s is not a valid hex value", i, SI_PTR(si));
+ vmThrowErr(pVM, "%.*s not recognized", i, SI_PTR(si));
}
pVM->base = oldbase;
@@ -164,6 +165,10 @@
pHash->name = list_name;
dictAppendWord(dp, list_name, constantParen, FW_DEFAULT);
dictAppendCell(dp, LVALUEtoCELL(pHash));
+
+ /*
+ ** Put __tempbase in the forth-wordlist
+ */
dictAppendWord(dp, "__tempbase", fTempBase, FW_DEFAULT);
/*
--- a/search.c
+++ b/search.c
@@ -4,7 +4,7 @@
** ANS Forth SEARCH and SEARCH-EXT word-set written in C
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 6 June 2000
-** $Id: search.c,v 1.5 2001/05/16 14:56:15 jsadler Exp $
+** $Id: search.c,v 1.6 2001/06/12 08:24:34 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -55,7 +55,7 @@
**************************************************************************/
static void definitions(FICL_VM *pVM)
{- FICL_DICT *pDict = ficlGetDict();
+ FICL_DICT *pDict = vmGetDict(pVM);
assert(pDict);
if (pDict->nLists < 1)
@@ -77,7 +77,7 @@
**************************************************************************/
static void forthWordlist(FICL_VM *pVM)
{- FICL_HASH *pHash = ficlGetDict()->pForthWords;
+ FICL_HASH *pHash = vmGetDict(pVM)->pForthWords;
stackPushPtr(pVM->pStack, pHash);
return;
}
@@ -91,7 +91,7 @@
static void getCurrent(FICL_VM *pVM)
{ficlLockDictionary(TRUE);
- stackPushPtr(pVM->pStack, ficlGetDict()->pCompile);
+ stackPushPtr(pVM->pStack, vmGetDict(pVM)->pCompile);
ficlLockDictionary(FALSE);
return;
}
@@ -107,7 +107,7 @@
**************************************************************************/
static void getOrder(FICL_VM *pVM)
{- FICL_DICT *pDict = ficlGetDict();
+ FICL_DICT *pDict = vmGetDict(pVM);
int nLists = pDict->nLists;
int i;
@@ -168,7 +168,7 @@
static void setCurrent(FICL_VM *pVM)
{FICL_HASH *pHash = stackPopPtr(pVM->pStack);
- FICL_DICT *pDict = ficlGetDict();
+ FICL_DICT *pDict = vmGetDict(pVM);
ficlLockDictionary(TRUE);
pDict->pCompile = pHash;
ficlLockDictionary(FALSE);
@@ -191,7 +191,7 @@
{int i;
int nLists = stackPopINT(pVM->pStack);
- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
if (nLists > FICL_DEFAULT_VOCS)
{@@ -235,7 +235,7 @@
**************************************************************************/
static void ficlWordlist(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
FICL_HASH *pHash;
FICL_UNS nBuckets;
@@ -256,7 +256,7 @@
**************************************************************************/
static void searchPop(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
int nLists;
ficlLockDictionary(TRUE);
@@ -278,7 +278,7 @@
**************************************************************************/
static void searchPush(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
ficlLockDictionary(TRUE);
if (dp->nLists > FICL_DEFAULT_VOCS)
@@ -300,7 +300,7 @@
{FICL_HASH *pHash = vmPop(pVM).p;
char *cp = pHash->name;
- int len = 0;
+ FICL_INT len = 0;
if (cp)
len = strlen(cp);
@@ -378,9 +378,9 @@
/*
** Set SEARCH environment query values
*/
- ficlSetEnv("search-order", FICL_TRUE);- ficlSetEnv("search-order-ext", FICL_TRUE);- ficlSetEnv("wordlists", FICL_DEFAULT_VOCS);+ ficlSetEnv(pSys, "search-order", FICL_TRUE);
+ ficlSetEnv(pSys, "search-order-ext", FICL_TRUE);
+ ficlSetEnv(pSys, "wordlists", FICL_DEFAULT_VOCS);
dictAppendWord(dp, "wid-get-name", widGetName, FW_DEFAULT);
dictAppendWord(dp, "wid-set-name", widSetName, FW_DEFAULT);
--- a/stack.c
+++ b/stack.c
@@ -3,7 +3,7 @@
** Forth Inspired Command Language
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 16 Oct 1997
-** $Id: stack.c,v 1.6 2001/05/16 14:56:15 jsadler Exp $
+** $Id: stack.c,v 1.7 2001/06/12 08:24:35 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -292,7 +292,7 @@
}
#if (FICL_WANT_FLOAT)
-void stackPushFloat(FICL_STACK *pStack, float f)
+void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f)
{*pStack->sp++ = LVALUEtoCELL(f);
}
--- a/testmain.c
+++ b/testmain.c
@@ -1,6 +1,6 @@
/*
** stub main for testing FICL under Win32
-** $Id: testmain.c,v 1.9 2001/05/10 14:47:30 jsadler Exp $
+** $Id: testmain.c,v 1.10 2001/06/12 08:24:37 jsadler Exp $
*/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -228,7 +228,7 @@
*/
static void spewHash(FICL_VM *pVM)
{- FICL_HASH *pHash = ficlGetDict()->pForthWords;
+ FICL_HASH *pHash = vmGetDict(pVM)->pForthWords;
FICL_WORD *pFW;
FILE *pOut;
unsigned i;
@@ -291,16 +291,16 @@
}
-void buildTestInterface()
+void buildTestInterface(FICL_SYSTEM *pSys)
{- ficlBuild("break", ficlBreak, FW_DEFAULT);- ficlBuild("clock", ficlClock, FW_DEFAULT);- ficlBuild("cd", ficlChDir, FW_DEFAULT);- ficlBuild("load", ficlLoad, FW_DEFAULT);- ficlBuild("pwd", ficlGetCWD, FW_DEFAULT);- ficlBuild("system", ficlSystem, FW_DEFAULT);- ficlBuild("spewhash", spewHash, FW_DEFAULT);- ficlBuild("clocks/sec", + ficlBuild(pSys, "break", ficlBreak, FW_DEFAULT);
+ ficlBuild(pSys, "clock", ficlClock, FW_DEFAULT);
+ ficlBuild(pSys, "cd", ficlChDir, FW_DEFAULT);
+ ficlBuild(pSys, "load", ficlLoad, FW_DEFAULT);
+ ficlBuild(pSys, "pwd", ficlGetCWD, FW_DEFAULT);
+ ficlBuild(pSys, "system", ficlSystem, FW_DEFAULT);
+ ficlBuild(pSys, "spewhash", spewHash, FW_DEFAULT);
+ ficlBuild(pSys, "clocks/sec",
clocksPerSec, FW_DEFAULT);
return;
@@ -320,10 +320,12 @@
int ret = 0;
char in[nINBUF];
FICL_VM *pVM;
- ficlInitSystem(10000);
- buildTestInterface();
- pVM = ficlNewVM();
+ FICL_SYSTEM *pSys;
+ pSys = ficlInitSystem(10000);
+ buildTestInterface(pSys);
+ pVM = ficlNewVM(pSys);
+
ret = ficlExec(pVM, ".ver .( " __DATE__ " ) cr quit");
/*
@@ -357,7 +359,7 @@
}
}
- ficlTermSystem();
+ ficlTermSystem(pSys);
return 0;
}
--- a/tools.c
+++ b/tools.c
@@ -3,7 +3,7 @@
** Forth Inspired Command Language - programming tools
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 20 June 2000
-** $Id: tools.c,v 1.7 2001/05/16 14:56:06 jsadler Exp $
+** $Id: tools.c,v 1.8 2001/06/12 08:24:37 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -95,7 +95,7 @@
**************************************************************************/
static void vmSetBreak(FICL_VM *pVM, BREAKPOINT *pBP)
{- FICL_WORD *pStep = ficlLookup("step-break");+ FICL_WORD *pStep = ficlLookup(pVM->pSys, "step-break");
assert(pStep);
pBP->address = pVM->ip;
@@ -121,9 +121,8 @@
** like it's in the dictionary address range.
** NOTE: this excludes :noname words!
**************************************************************************/
-int isAFiclWord(FICL_WORD *pFW)
+int isAFiclWord(FICL_DICT *pd, FICL_WORD *pFW)
{- FICL_DICT *pd = ficlGetDict();
if (!dictIncludes(pd, pFW))
return 0;
@@ -131,7 +130,16 @@
if (!dictIncludes(pd, pFW->name))
return 0;
- return ((pFW->nName > 0) && (pFW->name[pFW->nName] == '\0'));
+ if ((pFW->link != NULL) && !dictIncludes(pd, pFW->link))
+ return 0;
+
+ if ((pFW->nName <= 0) || (pFW->name[pFW->nName] != '\0'))
+ return 0;
+
+ if (strlen(pFW->name) != pFW->nName)
+ return 0;
+
+ return 1;
}
@@ -152,10 +160,10 @@
**************************************************************************/
#define nSEARCH_CELLS 100
-static FICL_WORD *findEnclosingWord(CELL *cp)
+static FICL_WORD *findEnclosingWord(FICL_VM *pVM, CELL *cp)
{FICL_WORD *pFW;
- FICL_DICT *pd = ficlGetDict();
+ FICL_DICT *pd = vmGetDict(pVM);
int i;
if (!dictIncludes(pd, (void *)cp))
@@ -164,7 +172,7 @@
for (i = nSEARCH_CELLS; i > 0; --i, --cp)
{pFW = (FICL_WORD *)(cp + 1 - (sizeof (FICL_WORD) / sizeof (CELL)));
- if (isAFiclWord(pFW))
+ if (isAFiclWord(pd, pFW))
return pFW;
}
@@ -188,7 +196,8 @@
static void seeColon(FICL_VM *pVM, CELL *pc)
{char *cp = pVM->pad + 1;
- FICL_WORD *pSemiParen = ficlLookup("(;)");+ FICL_DICT *pd = vmGetDict(pVM);
+ FICL_WORD *pSemiParen = ficlLookup(pVM->pSys, "(;)");
assert(pSemiParen);
for (; pc->p != pSemiParen; pc++)
@@ -195,18 +204,21 @@
{FICL_WORD *pFW = (FICL_WORD *)(pc->p);
- if (isAFiclWord(pFW))
+ if (isAFiclWord(pd, pFW))
{WORDKIND kind = ficlWordClassify(pFW);
CELL c;
- cp[-1] = ((void *)pc == (void *)pVM->ip) ? '>' : ' ';
+ if ((void *)pc == (void *)pVM->ip)
+ cp[-1] = '>';
+ else
+ cp[-1] = ' ';
switch (kind)
{case LITERAL:
c = *++pc;
- if (isAFiclWord(c.p))
+ if (isAFiclWord(pd, c.p))
{FICL_WORD *pLit = (FICL_WORD *)c.p;
sprintf(cp, " literal %.*s (%#lx)",
@@ -416,7 +428,7 @@
{FICL_WORD *pFW;
WORDKIND kind;
- FICL_WORD *pStep = ficlLookup("step-break");+ FICL_WORD *pStep = ficlLookup(pVM->pSys, "step-break");
assert(pStep);
pFW = *pVM->ip;
@@ -481,7 +493,7 @@
/*
** If there's an onStep, do it
*/
- pOnStep = ficlLookup("on-step");+ pOnStep = ficlLookup(pVM->pSys, "on-step");
if (pOnStep)
ficlExecXT(pVM, pOnStep);
@@ -516,7 +528,7 @@
else if (!strincmp(si.cp, "l", si.count))
{FICL_WORD *xt;
- xt = findEnclosingWord((CELL *)(pVM->ip));
+ xt = findEnclosingWord(pVM, (CELL *)(pVM->ip));
if (xt)
{stackPushPtr(pVM->pStack, xt);
@@ -622,7 +634,7 @@
int d = stackDepth(pStk);
int i;
CELL *pCell;
- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
vmCheckStack(pVM, 0, 0);
@@ -642,7 +654,7 @@
*/
if (dictIncludes(dp, c.p))
{- FICL_WORD *pFW = findEnclosingWord(c.p);
+ FICL_WORD *pFW = findEnclosingWord(pVM, c.p);
if (pFW)
{int offset = (CELL *)c.p - &pFW->param[0];
@@ -666,7 +678,7 @@
**************************************************************************/
static void forgetWid(FICL_VM *pVM)
{- FICL_DICT *pDict = ficlGetDict();
+ FICL_DICT *pDict = vmGetDict(pVM);
FICL_HASH *pHash;
pHash = (FICL_HASH *)stackPopPtr(pVM->pStack);
@@ -691,7 +703,7 @@
static void forget(FICL_VM *pVM)
{void *where;
- FICL_DICT *pDict = ficlGetDict();
+ FICL_DICT *pDict = vmGetDict(pVM);
FICL_HASH *pHash = pDict->pCompile;
ficlTick(pVM);
@@ -710,7 +722,7 @@
#define nCOLWIDTH 8
static void listWords(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
FICL_HASH *pHash = dp->pSearch[dp->nLists - 1];
FICL_WORD *wp;
int nChars = 0;
@@ -772,7 +784,7 @@
**************************************************************************/
static void listEnv(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetEnv();
+ FICL_DICT *dp = vmGetDict(pVM);
FICL_HASH *pHash = dp->pForthWords;
FICL_WORD *wp;
unsigned i;
@@ -808,7 +820,7 @@
vmGetWordToPad(pVM);
value = POPUNS();
- ficlSetEnv(pVM->pad, (FICL_UNS)value);
+ ficlSetEnv(pVM->pSys, pVM->pad, (FICL_UNS)value);
return;
}
@@ -823,7 +835,7 @@
vmGetWordToPad(pVM);
v2 = POPUNS();
v1 = POPUNS();
- ficlSetEnvD(pVM->pad, v1, v2);
+ ficlSetEnvD(pVM->pSys, pVM->pad, v1, v2);
return;
}
@@ -851,8 +863,8 @@
/*
** Set TOOLS environment query values
*/
- ficlSetEnv("tools", FICL_TRUE);- ficlSetEnv("tools-ext", FICL_FALSE);+ ficlSetEnv(pSys, "tools", FICL_TRUE);
+ ficlSetEnv(pSys, "tools-ext", FICL_FALSE);
/*
** Ficl extras
--- a/vm.c
+++ b/vm.c
@@ -3,7 +3,7 @@
** Forth Inspired Command Language - virtual machine methods
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 19 July 1997
-** $Id: vm.c,v 1.9 2001/05/16 14:56:13 jsadler Exp $
+** $Id: vm.c,v 1.10 2001/06/12 08:24:40 jsadler Exp $
*******************************************************************/
/*
** This file implements the virtual machine of FICL. Each virtual
@@ -157,6 +157,17 @@
M_INNER_LOOP(pVM);
}
#endif
+
+
+/**************************************************************************
+ v m G e t D i c t
+** Returns the address dictionary for this VM's system
+**************************************************************************/
+FICL_DICT *vmGetDict(FICL_VM *pVM)
+{+ assert(pVM);
+ return pVM->pSys->dp;
+}
/**************************************************************************
--- a/win32.c
+++ b/win32.c
@@ -244,8 +244,8 @@
{STRINGINFO si;
FICL_WORD *pFW;
- FICL_DICT *dp = ficlGetDict();
- FICL_CODE pCreateParen = ficlLookup("(create)")->code;+ FICL_DICT *dp = vmGetDict(pVM);
+ FICL_CODE pCreateParen = ficlLookup(pVM->pSys, "(create)")->code;
si = parseFileName(pVM);
@@ -268,8 +268,8 @@
{STRINGINFO si;
FICL_WORD *pFW;
- FICL_DICT *dp = ficlGetDict();
- FICL_CODE pCreateParen = ficlLookup("(create)")->code;+ FICL_DICT *dp = vmGetDict(pVM);
+ FICL_CODE pCreateParen = ficlLookup(pVM->pSys, "(create)")->code;
si = parseFileName(pVM);
--- a/words.c
+++ b/words.c
@@ -4,7 +4,7 @@
** ANS Forth CORE word-set written in C
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 19 July 1997
-** $Id: words.c,v 1.13 2001/05/16 14:56:08 jsadler Exp $
+** $Id: words.c,v 1.14 2001/06/12 08:24:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -98,7 +98,7 @@
static FICL_WORD *pToLocal1 = NULL;
static FICL_WORD *pLinkParen = NULL;
static FICL_WORD *pUnLinkParen = NULL;
-static int nLocals = 0;
+static FICL_INT nLocals = 0;
static CELL *pMarkLocals = NULL;
static void doLocalIm(FICL_VM *pVM);
@@ -151,7 +151,7 @@
*/
static void resolveBackBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
{- long offset;
+ FICL_INT offset;
CELL *patchAddr;
matchControlTag(pVM, tag);
@@ -174,7 +174,7 @@
*/
static void resolveForwardBranch(FICL_DICT *dp, FICL_VM *pVM, char *tag)
{- long offset;
+ FICL_INT offset;
CELL *patchAddr;
matchControlTag(pVM, tag);
@@ -475,7 +475,7 @@
static void colon(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
STRINGINFO si = vmGetWord(pVM);
pVM->state = COMPILE;
@@ -526,7 +526,7 @@
static void semicolonCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pSemiParen);
matchControlTag(pVM, colonTag);
@@ -535,7 +535,7 @@
assert(pUnLinkParen);
if (nLocals > 0)
{- FICL_DICT *pLoc = ficlGetLoc();
+ FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
dictEmpty(pLoc, pLoc->pForthWords->size);
dictAppendCell(dp, LVALUEtoCELL(pUnLinkParen));
}
@@ -566,7 +566,7 @@
static void exitCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pExitParen);
IGNORE(pVM);
@@ -619,7 +619,7 @@
static void constant(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
STRINGINFO si = vmGetWord(pVM);
#if FICL_ROBUST > 1
@@ -633,7 +633,7 @@
static void twoConstant(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
STRINGINFO si = vmGetWord(pVM);
CELL c;
@@ -1079,7 +1079,7 @@
static void ifCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pIfParen);
@@ -1134,8 +1134,8 @@
static void elseCoIm(FICL_VM *pVM)
{CELL *patchAddr;
- int offset;
- FICL_DICT *dp = ficlGetDict();
+ FICL_INT offset;
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pBranchParen);
/* (1) compile branch runtime */
@@ -1173,7 +1173,7 @@
static void endifCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
resolveForwardBranch(dp, pVM, origTag);
return;
}
@@ -1246,14 +1246,25 @@
for (i=0; i < FICL_MAX_PARSE_STEPS; i++)
{FICL_WORD *pFW = pSys->parseList[i];
- FICL_PARSE_STEP pStep;
if (pFW == NULL)
break;
- pStep = (FICL_PARSE_STEP)(pFW->param->fn);
- if ((*pStep)(pVM, si))
- return;
+ if (pFW->code == parseStepParen)
+ {+ FICL_PARSE_STEP pStep;
+ pStep = (FICL_PARSE_STEP)(pFW->param->fn);
+ if ((*pStep)(pVM, si))
+ return;
+ }
+ else
+ {+ stackPushPtr(pVM->pStack, SI_PTR(si));
+ stackPushUNS(pVM->pStack, SI_COUNT(si));
+ ficlExecXT(pVM, pFW);
+ if (stackPopINT(pVM->pStack))
+ return;
+ }
}
i = SI_COUNT(si);
@@ -1285,7 +1296,7 @@
**************************************************************************/
static int ficlParseWord(FICL_VM *pVM, STRINGINFO si)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
FICL_WORD *tempFW;
#if FICL_ROBUST
@@ -1296,7 +1307,7 @@
#if FICL_WANT_LOCALS
if (nLocals > 0)
{- tempFW = dictLookupLoc(dp, si);
+ tempFW = ficlLookupLoc(pVM->pSys, si);
}
else
#endif
@@ -1376,11 +1387,12 @@
static void addParseStep(FICL_VM *pVM)
{FICL_WORD *pStep;
+ FICL_DICT *pd = vmGetDict(pVM);
#if FICL_ROBUST > 1
vmCheckStack(pVM, 1, 0);
#endif
pStep = (FICL_WORD *)(stackPop(pVM->pStack).p);
- if ((pStep != NULL) && isAFiclWord(pStep))
+ if ((pStep != NULL) && isAFiclWord(pd, pStep))
ficlAddParseStep(pVM->pSys, pStep);
return;
}
@@ -1427,7 +1439,7 @@
static void literalIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pLitParen);
dictAppendCell(dp, LVALUEtoCELL(pLitParen));
@@ -1439,7 +1451,7 @@
static void twoLiteralIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pTwoLitParen);
dictAppendCell(dp, LVALUEtoCELL(pTwoLitParen));
@@ -1611,7 +1623,7 @@
static void doCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pDoParen);
@@ -1651,7 +1663,7 @@
static void qDoCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pQDoParen);
@@ -1721,7 +1733,7 @@
static void loopCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pLoopParen);
@@ -1734,7 +1746,7 @@
static void plusLoopCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pPLoopParen);
@@ -1769,18 +1781,18 @@
static void plusLoopParen(FICL_VM *pVM)
{- FICL_INT index,limit,increment;
- int flag;
+ FICL_INT index,limit,increment;
+ int flag;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 0);
+ vmCheckStack(pVM, 1, 0);
#endif
- index = stackGetTop(pVM->rStack).i;
- limit = stackFetch(pVM->rStack, 1).i;
- increment = POP().i;
-
- index += increment;
+ index = stackGetTop(pVM->rStack).i;
+ limit = stackFetch(pVM->rStack, 1).i;
+ increment = POP().i;
+
+ index += increment;
if (increment < 0)
flag = (index < limit);
@@ -1836,28 +1848,28 @@
static void toRStack(FICL_VM *pVM)
{#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 0);
+ vmCheckStack(pVM, 1, 0);
#endif
- stackPush(pVM->rStack, POP());
+ stackPush(pVM->rStack, POP());
}
static void fromRStack(FICL_VM *pVM)
{#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 1);
+ vmCheckStack(pVM, 0, 1);
#endif
- PUSH(stackPop(pVM->rStack));
+ PUSH(stackPop(pVM->rStack));
}
static void fetchRStack(FICL_VM *pVM)
{#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 1);
+ vmCheckStack(pVM, 0, 1);
#endif
- PUSH(stackGetTop(pVM->rStack));
+ PUSH(stackGetTop(pVM->rStack));
}
static void twoToR(FICL_VM *pVM)
@@ -1900,19 +1912,19 @@
static void variableParen(FICL_VM *pVM)
{- FICL_WORD *fw;
+ FICL_WORD *fw;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 1);
+ vmCheckStack(pVM, 0, 1);
#endif
- fw = pVM->runningWord;
- PUSHPTR(fw->param);
+ fw = pVM->runningWord;
+ PUSHPTR(fw->param);
}
static void variable(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
STRINGINFO si = vmGetWord(pVM);
dictAppendWord2(dp, si, variableParen, FW_DEFAULT);
@@ -1923,7 +1935,7 @@
static void twoVariable(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
STRINGINFO si = vmGetWord(pVM);
dictAppendWord2(dp, si, variableParen, FW_DEFAULT);
@@ -1939,9 +1951,9 @@
static void base(FICL_VM *pVM)
{- CELL *pBase;
+ CELL *pBase;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 1);
+ vmCheckStack(pVM, 0, 1);
#endif
pBase = (CELL *)(&pVM->base);
@@ -1971,20 +1983,20 @@
static void allot(FICL_VM *pVM)
{- FICL_DICT *dp;
- FICL_INT i;
+ FICL_DICT *dp;
+ FICL_INT i;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 0);
+ vmCheckStack(pVM, 1, 0);
#endif
- dp = ficlGetDict();
- i = POPINT();
+ dp = vmGetDict(pVM);
+ i = POPINT();
#if FICL_ROBUST
- dictCheck(dp, pVM, i);
+ dictCheck(dp, pVM, i);
#endif
- dictAllot(dp, i);
+ dictAllot(dp, i);
return;
}
@@ -1991,65 +2003,65 @@
static void here(FICL_VM *pVM)
{- FICL_DICT *dp;
+ FICL_DICT *dp;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 1);
+ vmCheckStack(pVM, 0, 1);
#endif
- dp = ficlGetDict();
- PUSHPTR(dp->here);
+ dp = vmGetDict(pVM);
+ PUSHPTR(dp->here);
return;
}
static void comma(FICL_VM *pVM)
{- FICL_DICT *dp;
- CELL c;
+ FICL_DICT *dp;
+ CELL c;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 0);
+ vmCheckStack(pVM, 1, 0);
#endif
- dp = ficlGetDict();
- c = POP();
- dictAppendCell(dp, c);
+ dp = vmGetDict(pVM);
+ c = POP();
+ dictAppendCell(dp, c);
return;
}
static void cComma(FICL_VM *pVM)
{- FICL_DICT *dp;
- char c;
+ FICL_DICT *dp;
+ char c;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 0);
+ vmCheckStack(pVM, 1, 0);
#endif
- dp = ficlGetDict();
- c = (char)POPINT();
- dictAppendChar(dp, c);
+ dp = vmGetDict(pVM);
+ c = (char)POPINT();
+ dictAppendChar(dp, c);
return;
}
static void cells(FICL_VM *pVM)
{- FICL_INT i;
+ FICL_INT i;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 1);
+ vmCheckStack(pVM, 1, 1);
#endif
- i = POPINT();
- PUSHINT(i * (FICL_INT)sizeof (CELL));
+ i = POPINT();
+ PUSHINT(i * (FICL_INT)sizeof (CELL));
return;
}
static void cellPlus(FICL_VM *pVM)
{- char *cp;
+ char *cp;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 1);
+ vmCheckStack(pVM, 1, 1);
#endif
- cp = POPPTR();
- PUSHPTR(cp + sizeof (CELL));
+ cp = POPPTR();
+ PUSHPTR(cp + sizeof (CELL));
return;
}
@@ -2064,19 +2076,19 @@
**************************************************************************/
void ficlTick(FICL_VM *pVM)
{- FICL_WORD *pFW = NULL;
- STRINGINFO si = vmGetWord(pVM);
+ FICL_WORD *pFW = NULL;
+ STRINGINFO si = vmGetWord(pVM);
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 1);
+ vmCheckStack(pVM, 0, 1);
#endif
- pFW = dictLookup(ficlGetDict(), si);
- if (!pFW)
- {- int i = SI_COUNT(si);
- vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
- }
- PUSHPTR(pFW);
+ pFW = dictLookup(vmGetDict(pVM), si);
+ if (!pFW)
+ {+ int i = SI_COUNT(si);
+ vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
+ }
+ PUSHPTR(pFW);
return;
}
@@ -2099,9 +2111,9 @@
static void postponeCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
FICL_WORD *pFW;
- FICL_WORD *pComma = ficlLookup(",");+ FICL_WORD *pComma = ficlLookup(pVM->pSys, ",");
assert(pComma);
ficlTick(pVM);
@@ -2151,7 +2163,7 @@
static void immediate(FICL_VM *pVM)
{IGNORE(pVM);
- dictSetImmediate(ficlGetDict());
+ dictSetImmediate(vmGetDict(pVM));
return;
}
@@ -2159,7 +2171,7 @@
static void compileOnly(FICL_VM *pVM)
{IGNORE(pVM);
- dictSetFlags(ficlGetDict(), FW_COMPILE, 0);
+ dictSetFlags(vmGetDict(pVM), FW_COMPILE, 0);
return;
}
@@ -2177,27 +2189,27 @@
static void stringLit(FICL_VM *pVM)
{- FICL_STRING *sp;
- FICL_COUNT count;
- char *cp;
+ FICL_STRING *sp;
+ FICL_COUNT count;
+ char *cp;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 2);
+ vmCheckStack(pVM, 0, 2);
#endif
- sp = (FICL_STRING *)(pVM->ip);
- count = sp->count;
- cp = sp->text;
- PUSHPTR(cp);
- PUSHUNS(count);
- cp += count + 1;
- cp = alignPtr(cp);
- pVM->ip = (IPTYPE)(void *)cp;
+ sp = (FICL_STRING *)(pVM->ip);
+ count = sp->count;
+ cp = sp->text;
+ PUSHPTR(cp);
+ PUSHUNS(count);
+ cp += count + 1;
+ cp = alignPtr(cp);
+ pVM->ip = (IPTYPE)(void *)cp;
}
static void dotQuoteCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
- FICL_WORD *pType = ficlLookup("type");+ FICL_DICT *dp = vmGetDict(pVM);
+ FICL_WORD *pType = ficlLookup(pVM->pSys, "type");
assert(pType);
dictAppendCell(dp, LVALUEtoCELL(pStringLit));
dp->here = PTRtoCELL vmGetString(pVM, (FICL_STRING *)dp->here, '\"');
@@ -2244,17 +2256,17 @@
**************************************************************************/
static void sLiteralCoIm(FICL_VM *pVM)
{- FICL_DICT *dp;
- char *cp, *cpDest;
- FICL_UNS u;
+ FICL_DICT *dp;
+ char *cp, *cpDest;
+ FICL_UNS u;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 2, 0);
+ vmCheckStack(pVM, 2, 0);
#endif
- dp = ficlGetDict();
- u = POPUNS();
- cp = POPPTR();
+ dp = vmGetDict(pVM);
+ u = POPUNS();
+ cp = POPPTR();
dictAppendCell(dp, LVALUEtoCELL(pStringLit));
cpDest = (char *) dp->here;
@@ -2279,7 +2291,7 @@
static void state(FICL_VM *pVM)
{#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 1);
+ vmCheckStack(pVM, 0, 1);
#endif
PUSHPTR(&pVM->state);
return;
@@ -2295,14 +2307,14 @@
static void createParen(FICL_VM *pVM)
{- CELL *pCell;
+ CELL *pCell;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 1);
+ vmCheckStack(pVM, 0, 1);
#endif
- pCell = pVM->runningWord->param;
- PUSHPTR(pCell+1);
+ pCell = pVM->runningWord->param;
+ PUSHPTR(pCell+1);
return;
}
@@ -2309,7 +2321,7 @@
static void create(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
STRINGINFO si = vmGetWord(pVM);
dictAppendWord2(dp, si, createParen, FW_DEFAULT);
@@ -2320,16 +2332,16 @@
static void doDoes(FICL_VM *pVM)
{- CELL *pCell;
- IPTYPE tempIP;
+ CELL *pCell;
+ IPTYPE tempIP;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 0, 1);
+ vmCheckStack(pVM, 0, 1);
#endif
- pCell = pVM->runningWord->param;
- tempIP = (IPTYPE)((*pCell).p);
- PUSHPTR(pCell+1);
- vmPushIP(pVM, tempIP);
+ pCell = pVM->runningWord->param;
+ tempIP = (IPTYPE)((*pCell).p);
+ PUSHPTR(pCell+1);
+ vmPushIP(pVM, tempIP);
return;
}
@@ -2336,7 +2348,7 @@
static void doesParen(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
dp->smudge->code = doDoes;
dp->smudge->param[0] = LVALUEtoCELL(pVM->ip);
vmPopIP(pVM);
@@ -2346,12 +2358,12 @@
static void doesCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
#if FICL_WANT_LOCALS
assert(pUnLinkParen);
if (nLocals > 0)
{- FICL_DICT *pLoc = ficlGetLoc();
+ FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
dictEmpty(pLoc, pLoc->pForthWords->size);
dictAppendCell(dp, LVALUEtoCELL(pUnLinkParen));
}
@@ -2373,14 +2385,14 @@
**************************************************************************/
static void toBody(FICL_VM *pVM)
{- FICL_WORD *pFW;
+ FICL_WORD *pFW;
/*#$-GUY CHANGE: Added robustness.-$#*/
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 1);
+ vmCheckStack(pVM, 1, 1);
#endif
- pFW = POPPTR();
- PUSHPTR(pFW->param + 1);
+ pFW = POPPTR();
+ PUSHPTR(pFW->param + 1);
return;
}
@@ -2391,13 +2403,13 @@
*/
static void fromBody(FICL_VM *pVM)
{- char *ptr;
+ char *ptr;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 1);
+ vmCheckStack(pVM, 1, 1);
#endif
- ptr = (char *)POPPTR() - sizeof (FICL_WORD);
- PUSHPTR(ptr);
+ ptr = (char *)POPPTR() - sizeof (FICL_WORD);
+ PUSHPTR(ptr);
return;
}
@@ -2409,14 +2421,14 @@
*/
static void toName(FICL_VM *pVM)
{- FICL_WORD *pFW;
+ FICL_WORD *pFW;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 2);
+ vmCheckStack(pVM, 1, 2);
#endif
- pFW = POPPTR();
- PUSHPTR(pFW->name);
- PUSHUNS(pFW->nName);
+ pFW = POPPTR();
+ PUSHPTR(pFW->name);
+ PUSHUNS(pFW->nName);
return;
}
@@ -2423,7 +2435,7 @@
static void getLastWord(FICL_VM *pVM)
{- FICL_DICT *pDict = ficlGetDict();
+ FICL_DICT *pDict = vmGetDict(pVM);
FICL_WORD *wp = pDict->smudge;
assert(wp);
vmPush(pVM, LVALUEtoCELL(wp));
@@ -2474,18 +2486,18 @@
*/
static void numberSign(FICL_VM *pVM)
{- FICL_STRING *sp;
- DPUNS u;
- UNS16 rem;
+ FICL_STRING *sp;
+ DPUNS u;
+ UNS16 rem;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 2, 2);
+ vmCheckStack(pVM, 2, 2);
#endif
- sp = PTRtoSTRING pVM->pad;
- u = u64Pop(pVM->pStack);
- rem = m64UMod(&u, (UNS16)(pVM->base));
- sp->text[sp->count++] = digit_to_char(rem);
- u64Push(pVM->pStack, u);
+ sp = PTRtoSTRING pVM->pad;
+ u = u64Pop(pVM->pStack);
+ rem = m64UMod(&u, (UNS16)(pVM->base));
+ sp->text[sp->count++] = digit_to_char(rem);
+ u64Push(pVM->pStack, u);
return;
}
@@ -2497,17 +2509,17 @@
*/
static void numberSignGreater(FICL_VM *pVM)
{- FICL_STRING *sp;
+ FICL_STRING *sp;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 2, 2);
+ vmCheckStack(pVM, 2, 2);
#endif
- sp = PTRtoSTRING pVM->pad;
- sp->text[sp->count] = 0;
- strrev(sp->text);
- DROP(2);
- PUSHPTR(sp->text);
- PUSHUNS(sp->count);
+ sp = PTRtoSTRING pVM->pad;
+ sp->text[sp->count] = 0;
+ strrev(sp->text);
+ DROP(2);
+ PUSHPTR(sp->text);
+ PUSHUNS(sp->count);
return;
}
@@ -2520,24 +2532,24 @@
*/
static void numberSignS(FICL_VM *pVM)
{- FICL_STRING *sp;
- DPUNS u;
- UNS16 rem;
+ FICL_STRING *sp;
+ DPUNS u;
+ UNS16 rem;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 2, 2);
+ vmCheckStack(pVM, 2, 2);
#endif
- sp = PTRtoSTRING pVM->pad;
- u = u64Pop(pVM->pStack);
+ sp = PTRtoSTRING pVM->pad;
+ u = u64Pop(pVM->pStack);
- do
- {- rem = m64UMod(&u, (UNS16)(pVM->base));
- sp->text[sp->count++] = digit_to_char(rem);
- }
- while (u.hi || u.lo);
+ do
+ {+ rem = m64UMod(&u, (UNS16)(pVM->base));
+ sp->text[sp->count++] = digit_to_char(rem);
+ }
+ while (u.hi || u.lo);
- u64Push(pVM->pStack, u);
+ u64Push(pVM->pStack, u);
return;
}
@@ -2548,15 +2560,15 @@
*/
static void hold(FICL_VM *pVM)
{- FICL_STRING *sp;
- int i;
+ FICL_STRING *sp;
+ int i;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 0);
+ vmCheckStack(pVM, 1, 0);
#endif
- sp = PTRtoSTRING pVM->pad;
- i = POPINT();
- sp->text[sp->count++] = (char) i;
+ sp = PTRtoSTRING pVM->pad;
+ i = POPINT();
+ sp->text[sp->count++] = (char) i;
return;
}
@@ -2568,16 +2580,16 @@
*/
static void sign(FICL_VM *pVM)
{- FICL_STRING *sp;
- int i;
+ FICL_STRING *sp;
+ int i;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 1, 0);
+ vmCheckStack(pVM, 1, 0);
#endif
- sp = PTRtoSTRING pVM->pad;
- i = POPINT();
- if (i < 0)
- sp->text[sp->count++] = '-';
+ sp = PTRtoSTRING pVM->pad;
+ i = POPINT();
+ if (i < 0)
+ sp->text[sp->count++] = '-';
return;
}
@@ -2598,19 +2610,19 @@
**************************************************************************/
static void toNumber(FICL_VM *pVM)
{- FICL_UNS count;
- char *cp;
- DPUNS accum;
- FICL_UNS base = pVM->base;
- FICL_UNS ch;
- FICL_UNS digit;
+ FICL_UNS count;
+ char *cp;
+ DPUNS accum;
+ FICL_UNS base = pVM->base;
+ FICL_UNS ch;
+ FICL_UNS digit;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,4,4);
+ vmCheckStack(pVM,4,4);
#endif
- count = POPUNS();
- cp = (char *)POPPTR();
+ count = POPUNS();
+ cp = (char *)POPPTR();
accum = u64Pop(pVM->pStack);
for (ch = *cp; count > 0; ch = *++cp, count--)
@@ -2691,17 +2703,17 @@
**************************************************************************/
static void accept(FICL_VM *pVM)
{- FICL_UNS count, len;
- char *cp;
- char *pBuf, *pEnd;
+ FICL_UNS count, len;
+ char *cp;
+ char *pBuf, *pEnd;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,1);
+ vmCheckStack(pVM,2,1);
#endif
- pBuf = vmGetInBuf(pVM);
+ pBuf = vmGetInBuf(pVM);
pEnd = vmGetInBufEnd(pVM);
- len = pEnd - pBuf;
+ len = pEnd - pBuf;
if (len == 0)
vmThrow(pVM, VM_RESTART);
@@ -2729,7 +2741,7 @@
**************************************************************************/
static void align(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
IGNORE(pVM);
dictAlign(dp);
return;
@@ -2742,13 +2754,13 @@
**************************************************************************/
static void aligned(FICL_VM *pVM)
{- void *addr;
+ void *addr;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,1,1);
+ vmCheckStack(pVM,1,1);
#endif
- addr = POPPTR();
- PUSHPTR(alignPtr(addr));
+ addr = POPPTR();
+ PUSHPTR(alignPtr(addr));
return;
}
@@ -2764,7 +2776,7 @@
**************************************************************************/
static void beginCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
markBranch(dp, pVM, destTag);
return;
}
@@ -2771,7 +2783,7 @@
static void untilCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pIfParen);
@@ -2782,7 +2794,7 @@
static void whileCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pIfParen);
@@ -2795,7 +2807,7 @@
static void repeatCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pBranchParen);
dictAppendCell(dp, LVALUEtoCELL(pBranchParen));
@@ -2810,7 +2822,7 @@
static void againCoIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
assert(pBranchParen);
dictAppendCell(dp, LVALUEtoCELL(pBranchParen));
@@ -2837,13 +2849,13 @@
**************************************************************************/
static void ficlChar(FICL_VM *pVM)
{- STRINGINFO si;
+ STRINGINFO si;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,0,1);
+ vmCheckStack(pVM,0,1);
#endif
- si = vmGetWord(pVM);
- PUSHUNS((FICL_UNS)(si.cp[0]));
+ si = vmGetWord(pVM);
+ PUSHUNS((FICL_UNS)(si.cp[0]));
return;
}
@@ -2861,13 +2873,13 @@
**************************************************************************/
static void charPlus(FICL_VM *pVM)
{- char *cp;
+ char *cp;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,1,1);
+ vmCheckStack(pVM,1,1);
#endif
- cp = POPPTR();
- PUSHPTR(cp + 1);
+ cp = POPPTR();
+ PUSHPTR(cp + 1);
return;
}
@@ -2883,16 +2895,16 @@
#endif
static void ficlChars(FICL_VM *pVM)
{- if (sizeof (char) > 1)
- {- FICL_INT i;
+ if (sizeof (char) > 1)
+ {+ FICL_INT i;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,1,1);
+ vmCheckStack(pVM,1,1);
#endif
- i = POPINT();
- PUSHINT(i * sizeof (char));
- }
- /* otherwise no-op! */
+ i = POPINT();
+ PUSHINT(i * sizeof (char));
+ }
+ /* otherwise no-op! */
return;
}
#if defined (_M_IX86)
@@ -2910,14 +2922,14 @@
**************************************************************************/
static void count(FICL_VM *pVM)
{- FICL_STRING *sp;
+ FICL_STRING *sp;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,1,2);
+ vmCheckStack(pVM,1,2);
#endif
- sp = POPPTR();
- PUSHPTR(sp->text);
- PUSHUNS(sp->count);
+ sp = POPPTR();
+ PUSHPTR(sp->text);
+ PUSHUNS(sp->count);
return;
}
@@ -2936,32 +2948,32 @@
**************************************************************************/
static void environmentQ(FICL_VM *pVM)
{- FICL_DICT *envp;
- FICL_COUNT len;
- char *cp;
- FICL_WORD *pFW;
- STRINGINFO si;
+ FICL_DICT *envp;
+ FICL_COUNT len;
+ char *cp;
+ FICL_WORD *pFW;
+ STRINGINFO si;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,1);
+ vmCheckStack(pVM,2,1);
#endif
- envp = ficlGetEnv();
- len = (FICL_COUNT)POPUNS();
- cp = POPPTR();
+ envp = ficlGetEnv(pVM->pSys);
+ len = (FICL_COUNT)POPUNS();
+ cp = POPPTR();
- IGNORE(len);
- SI_PSZ(si, cp);
- pFW = dictLookup(envp, si);
+ IGNORE(len);
+ SI_PSZ(si, cp);
+ pFW = dictLookup(envp, si);
- if (pFW != NULL)
- {- vmExecute(pVM, pFW);
- PUSHINT(FICL_TRUE);
- }
- else
- {- PUSHINT(FICL_FALSE);
- }
+ if (pFW != NULL)
+ {+ vmExecute(pVM, pFW);
+ PUSHINT(FICL_TRUE);
+ }
+ else
+ {+ PUSHINT(FICL_FALSE);
+ }
return;
}
@@ -2977,24 +2989,24 @@
**************************************************************************/
static void evaluate(FICL_VM *pVM)
{- FICL_UNS count;
- char *cp;
- CELL id;
+ FICL_UNS count;
+ char *cp;
+ CELL id;
int result;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,0);
+ vmCheckStack(pVM,2,0);
#endif
- count = POPUNS();
- cp = POPPTR();
+ count = POPUNS();
+ cp = POPPTR();
- IGNORE(count);
- id = pVM->sourceID;
- pVM->sourceID.i = -1;
- result = ficlExecC(pVM, cp, count);
- pVM->sourceID = id;
- if (result != VM_OUTOFTEXT)
- vmThrow(pVM, result);
+ IGNORE(count);
+ id = pVM->sourceID;
+ pVM->sourceID.i = -1;
+ result = ficlExecC(pVM, cp, count);
+ pVM->sourceID = id;
+ if (result != VM_OUTOFTEXT)
+ vmThrow(pVM, result);
return;
}
@@ -3010,7 +3022,7 @@
**************************************************************************/
static void stringQuoteIm(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
if (pVM->state == INTERPRET)
{@@ -3036,31 +3048,31 @@
**************************************************************************/
static void type(FICL_VM *pVM)
{- FICL_UNS count;
- char *cp;
+ FICL_UNS count;
+ char *cp;
#if FICL_ROBUST > 1
- vmCheckStack(pVM, 2, 0);
+ vmCheckStack(pVM, 2, 0);
#endif
- count = POPUNS();
- cp = POPPTR();
+ count = POPUNS();
+ cp = POPPTR();
- /*
- ** 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 (cp[count] != 0)
- {- char *pDest = (char *)ficlGetDict()->here;
- if (cp != pDest)
- strncpy(pDest, cp, count);
+ /*
+ ** 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 (cp[count] != 0)
+ {+ char *pDest = (char *)vmGetDict(pVM)->here;
+ if (cp != pDest)
+ strncpy(pDest, cp, count);
- pDest[count] = '\0';
- cp = pDest;
- }
+ pDest[count] = '\0';
+ cp = pDest;
+ }
- vmTextOut(pVM, cp, 0);
+ vmTextOut(pVM, cp, 0);
return;
}
@@ -3080,27 +3092,27 @@
**************************************************************************/
static void ficlWord(FICL_VM *pVM)
{- FICL_STRING *sp;
- char delim;
- STRINGINFO si;
+ FICL_STRING *sp;
+ char delim;
+ STRINGINFO si;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,1,1);
+ vmCheckStack(pVM,1,1);
#endif
- sp = (FICL_STRING *)pVM->pad;
- delim = (char)POPINT();
+ sp = (FICL_STRING *)pVM->pad;
+ delim = (char)POPINT();
si = vmParseStringEx(pVM, delim, 1);
- if (SI_COUNT(si) > nPAD-1)
- SI_SETLEN(si, nPAD-1);
+ if (SI_COUNT(si) > nPAD-1)
+ SI_SETLEN(si, nPAD-1);
- sp->count = (FICL_COUNT)SI_COUNT(si);
- strncpy(sp->text, SI_PTR(si), SI_COUNT(si));
- /*#$-GUY CHANGE: I added this.-$#*/
- sp->text[sp->count] = 0;
- strcat(sp->text, " ");
+ sp->count = (FICL_COUNT)SI_COUNT(si);
+ strncpy(sp->text, SI_PTR(si), SI_COUNT(si));
+ /*#$-GUY CHANGE: I added this.-$#*/
+ sp->text[sp->count] = 0;
+ strcat(sp->text, " ");
- PUSHPTR(sp);
+ PUSHPTR(sp);
return;
}
@@ -3114,14 +3126,14 @@
**************************************************************************/
static void parseNoCopy(FICL_VM *pVM)
{- STRINGINFO si;
+ STRINGINFO si;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,0,2);
+ vmCheckStack(pVM,0,2);
#endif
- si = vmGetWord0(pVM);
- PUSHPTR(SI_PTR(si));
- PUSHUNS(SI_COUNT(si));
+ si = vmGetWord0(pVM);
+ PUSHPTR(SI_PTR(si));
+ PUSHUNS(SI_COUNT(si));
return;
}
@@ -3137,18 +3149,18 @@
**************************************************************************/
static void parse(FICL_VM *pVM)
{- STRINGINFO si;
- char delim;
+ STRINGINFO si;
+ char delim;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,1,2);
+ vmCheckStack(pVM,1,2);
#endif
- delim = (char)POPINT();
+ delim = (char)POPINT();
- si = vmParseStringEx(pVM, delim, 0);
- PUSHPTR(SI_PTR(si));
- PUSHUNS(SI_COUNT(si));
+ si = vmParseStringEx(pVM, delim, 0);
+ PUSHPTR(SI_PTR(si));
+ PUSHUNS(SI_COUNT(si));
return;
}
@@ -3161,21 +3173,21 @@
**************************************************************************/
static void fill(FICL_VM *pVM)
{- char ch;
- FICL_UNS u;
- char *cp;
+ char ch;
+ FICL_UNS u;
+ char *cp;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,3,0);
+ vmCheckStack(pVM,3,0);
#endif
- ch = (char)POPINT();
- u = POPUNS();
- cp = (char *)POPPTR();
+ ch = (char)POPINT();
+ u = POPUNS();
+ cp = (char *)POPPTR();
- while (u > 0)
- {- *cp++ = ch;
- u--;
- }
+ while (u > 0)
+ {+ *cp++ = ch;
+ u--;
+ }
return;
}
@@ -3192,26 +3204,26 @@
**************************************************************************/
static void find(FICL_VM *pVM)
{- FICL_STRING *sp;
- FICL_WORD *pFW;
- STRINGINFO si;
+ FICL_STRING *sp;
+ FICL_WORD *pFW;
+ STRINGINFO si;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,1,2);
+ vmCheckStack(pVM,1,2);
#endif
- sp = POPPTR();
- SI_PFS(si, sp);
- pFW = dictLookup(ficlGetDict(), si);
- if (pFW)
- {- PUSHPTR(pFW);
- PUSHINT((wordIsImmediate(pFW) ? 1 : -1));
- }
- else
- {- PUSHPTR(sp);
- PUSHUNS(0);
- }
+ sp = POPPTR();
+ SI_PFS(si, sp);
+ pFW = dictLookup(vmGetDict(pVM), si);
+ if (pFW)
+ {+ PUSHPTR(pFW);
+ PUSHINT((wordIsImmediate(pFW) ? 1 : -1));
+ }
+ else
+ {+ PUSHPTR(sp);
+ PUSHUNS(0);
+ }
return;
}
@@ -3227,18 +3239,18 @@
**************************************************************************/
static void fmSlashMod(FICL_VM *pVM)
{- DPINT d1;
- FICL_INT n1;
- INTQR qr;
+ DPINT d1;
+ FICL_INT n1;
+ INTQR qr;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,3,2);
+ vmCheckStack(pVM,3,2);
#endif
- n1 = POPINT();
- d1 = i64Pop(pVM->pStack);
- qr = m64FlooredDivI(d1, n1);
- PUSHINT(qr.rem);
- PUSHINT(qr.quot);
+ n1 = POPINT();
+ d1 = i64Pop(pVM->pStack);
+ qr = m64FlooredDivI(d1, n1);
+ PUSHINT(qr.rem);
+ PUSHINT(qr.quot);
return;
}
@@ -3253,18 +3265,18 @@
**************************************************************************/
static void smSlashRem(FICL_VM *pVM)
{- DPINT d1;
- FICL_INT n1;
- INTQR qr;
+ DPINT d1;
+ FICL_INT n1;
+ INTQR qr;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,3,2);
+ vmCheckStack(pVM,3,2);
#endif
- n1 = POPINT();
- d1 = i64Pop(pVM->pStack);
- qr = m64SymmetricDivI(d1, n1);
- PUSHINT(qr.rem);
- PUSHINT(qr.quot);
+ n1 = POPINT();
+ d1 = i64Pop(pVM->pStack);
+ qr = m64SymmetricDivI(d1, n1);
+ PUSHINT(qr.rem);
+ PUSHINT(qr.quot);
return;
}
@@ -3271,18 +3283,18 @@
static void ficlMod(FICL_VM *pVM)
{- DPINT d1;
- FICL_INT n1;
- INTQR qr;
+ DPINT d1;
+ FICL_INT n1;
+ INTQR qr;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,1);
+ vmCheckStack(pVM,2,1);
#endif
- n1 = POPINT();
- d1.lo = POPINT();
- i64Extend(d1);
- qr = m64SymmetricDivI(d1, n1);
- PUSHINT(qr.rem);
+ n1 = POPINT();
+ d1.lo = POPINT();
+ i64Extend(d1);
+ qr = m64SymmetricDivI(d1, n1);
+ PUSHINT(qr.rem);
return;
}
@@ -3326,15 +3338,15 @@
**************************************************************************/
static void lshift(FICL_VM *pVM)
{- FICL_UNS nBits;
- FICL_UNS x1;
+ FICL_UNS nBits;
+ FICL_UNS x1;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,1);
+ vmCheckStack(pVM,2,1);
#endif
- nBits = POPUNS();
- x1 = POPUNS();
- PUSHUNS(x1 << nBits);
+ nBits = POPUNS();
+ x1 = POPUNS();
+ PUSHUNS(x1 << nBits);
return;
}
@@ -3341,16 +3353,16 @@
static void rshift(FICL_VM *pVM)
{- FICL_UNS nBits;
- FICL_UNS x1;
+ FICL_UNS nBits;
+ FICL_UNS x1;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,1);
+ vmCheckStack(pVM,2,1);
#endif
- nBits = POPUNS();
- x1 = POPUNS();
+ nBits = POPUNS();
+ x1 = POPUNS();
- PUSHUNS(x1 >> nBits);
+ PUSHUNS(x1 >> nBits);
return;
}
@@ -3362,18 +3374,18 @@
**************************************************************************/
static void mStar(FICL_VM *pVM)
{- FICL_INT n2;
- FICL_INT n1;
- DPINT d;
+ FICL_INT n2;
+ FICL_INT n1;
+ DPINT d;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,2);
+ vmCheckStack(pVM,2,2);
#endif
- n2 = POPINT();
- n1 = POPINT();
+ n2 = POPINT();
+ n1 = POPINT();
- d = m64MulI(n1, n2);
- i64Push(pVM->pStack, d);
+ d = m64MulI(n1, n2);
+ i64Push(pVM->pStack, d);
return;
}
@@ -3380,18 +3392,18 @@
static void umStar(FICL_VM *pVM)
{- FICL_UNS u2;
- FICL_UNS u1;
- DPUNS ud;
+ FICL_UNS u2;
+ FICL_UNS u1;
+ DPUNS ud;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,2);
+ vmCheckStack(pVM,2,2);
#endif
- u2 = POPUNS();
- u1 = POPUNS();
+ u2 = POPUNS();
+ u1 = POPUNS();
- ud = ficlLongMul(u1, u2);
- u64Push(pVM->pStack, ud);
+ ud = ficlLongMul(u1, u2);
+ u64Push(pVM->pStack, ud);
return;
}
@@ -3402,31 +3414,31 @@
**************************************************************************/
static void ficlMax(FICL_VM *pVM)
{- FICL_INT n2;
- FICL_INT n1;
+ FICL_INT n2;
+ FICL_INT n1;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,1);
+ vmCheckStack(pVM,2,1);
#endif
- n2 = POPINT();
- n1 = POPINT();
+ n2 = POPINT();
+ n1 = POPINT();
- PUSHINT((n1 > n2) ? n1 : n2);
+ PUSHINT((n1 > n2) ? n1 : n2);
return;
}
static void ficlMin(FICL_VM *pVM)
{- FICL_INT n2;
- FICL_INT n1;
+ FICL_INT n2;
+ FICL_INT n1;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,1);
+ vmCheckStack(pVM,2,1);
#endif
- n2 = POPINT();
- n1 = POPINT();
+ n2 = POPINT();
+ n1 = POPINT();
- PUSHINT((n1 < n2) ? n1 : n2);
+ PUSHINT((n1 < n2) ? n1 : n2);
return;
}
@@ -3443,16 +3455,16 @@
**************************************************************************/
static void move(FICL_VM *pVM)
{- FICL_UNS u;
- char *addr2;
- char *addr1;
+ FICL_UNS u;
+ char *addr2;
+ char *addr1;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,3,0);
+ vmCheckStack(pVM,3,0);
#endif
- u = POPUNS();
- addr2 = POPPTR();
- addr1 = POPPTR();
+ u = POPUNS();
+ addr2 = POPPTR();
+ addr1 = POPPTR();
if (u == 0)
return;
@@ -3483,7 +3495,7 @@
**************************************************************************/
static void recurseCoIm(FICL_VM *pVM)
{- FICL_DICT *pDict = ficlGetDict();
+ FICL_DICT *pDict = vmGetDict(pVM);
IGNORE(pVM);
dictAppendCell(pDict, LVALUEtoCELL(pDict->smudge));
@@ -3499,16 +3511,16 @@
**************************************************************************/
static void sToD(FICL_VM *pVM)
{- FICL_INT s;
+ FICL_INT s;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,1,2);
+ vmCheckStack(pVM,1,2);
#endif
- s = POPINT();
+ s = POPINT();
- /* sign extend to 64 bits.. */
- PUSHINT(s);
- PUSHINT((s < 0) ? -1 : 0);
+ /* sign extend to 64 bits.. */
+ PUSHINT(s);
+ PUSHINT((s < 0) ? -1 : 0);
return;
}
@@ -3522,9 +3534,9 @@
static void source(FICL_VM *pVM)
{#if FICL_ROBUST > 1
- vmCheckStack(pVM,0,2);
+ vmCheckStack(pVM,0,2);
#endif
- PUSHPTR(pVM->tib.cp);
+ PUSHPTR(pVM->tib.cp);
PUSHINT(vmGetInBufLen(pVM));
return;
}
@@ -3548,9 +3560,9 @@
static void toIn(FICL_VM *pVM)
{#if FICL_ROBUST > 1
- vmCheckStack(pVM,0,1);
+ vmCheckStack(pVM,0,1);
#endif
- PUSHPTR(&pVM->tib.index);
+ PUSHPTR(&pVM->tib.index);
return;
}
@@ -3563,7 +3575,7 @@
**************************************************************************/
static void colonNoName(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
FICL_WORD *pFW;
STRINGINFO si;
@@ -3605,7 +3617,7 @@
static void userVariable(FICL_VM *pVM)
{- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
STRINGINFO si = vmGetWord(pVM);
CELL c;
@@ -3633,13 +3645,13 @@
static void toValue(FICL_VM *pVM)
{STRINGINFO si = vmGetWord(pVM);
- FICL_DICT *dp = ficlGetDict();
+ FICL_DICT *dp = vmGetDict(pVM);
FICL_WORD *pFW;
#if FICL_WANT_LOCALS
if ((nLocals > 0) && (pVM->state == COMPILE))
{- FICL_DICT *pLoc = ficlGetLoc();
+ FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
pFW = dictLookup(pLoc, si);
if (pFW && (pFW->code == doLocalIm))
{@@ -3761,8 +3773,8 @@
*/
static void doLocalIm(FICL_VM *pVM)
{- FICL_DICT *pDict = ficlGetDict();
- int nLocal = pVM->runningWord->param[0].i;
+ FICL_DICT *pDict = vmGetDict(pVM);
+ FICL_INT nLocal = pVM->runningWord->param[0].i;
if (pVM->state == INTERPRET)
{@@ -3814,20 +3826,20 @@
**************************************************************************/
static void localParen(FICL_VM *pVM)
{- static CELL *pMark = NULL;
- FICL_DICT *pDict;
- STRINGINFO si;
+ static CELL *pMark = NULL;
+ FICL_DICT *pDict;
+ STRINGINFO si;
#if FICL_ROBUST > 1
- vmCheckStack(pVM,2,0);
+ vmCheckStack(pVM,2,0);
#endif
- pDict = ficlGetDict();
- SI_SETLEN(si, POPUNS());
- SI_SETPTR(si, (char *)POPPTR());
+ pDict = vmGetDict(pVM);
+ SI_SETLEN(si, POPUNS());
+ SI_SETPTR(si, (char *)POPPTR());
if (SI_COUNT(si) > 0)
{ /* add a local to the **locals** dict and update nLocals */- FICL_DICT *pLoc = ficlGetLoc();
+ FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
if (nLocals >= FICL_MAX_LOCALS)
{vmThrowErr(pVM, "Error: out of local space");
@@ -3877,8 +3889,8 @@
static void do2LocalIm(FICL_VM *pVM)
{- FICL_DICT *pDict = ficlGetDict();
- int nLocal = pVM->runningWord->param[0].i;
+ FICL_DICT *pDict = vmGetDict(pVM);
+ FICL_INT nLocal = pVM->runningWord->param[0].i;
if (pVM->state == INTERPRET)
{@@ -3905,7 +3917,7 @@
static void twoLocalParen(FICL_VM *pVM)
{- FICL_DICT *pDict = ficlGetDict();
+ FICL_DICT *pDict = vmGetDict(pVM);
STRINGINFO si;
SI_SETLEN(si, stackPopUNS(pVM->pStack));
SI_SETPTR(si, (char *)stackPopPtr(pVM->pStack));
@@ -3912,7 +3924,7 @@
if (SI_COUNT(si) > 0)
{ /* add a local to the **locals** dict and update nLocals */- FICL_DICT *pLoc = ficlGetLoc();
+ FICL_DICT *pLoc = ficlGetLoc(pVM->pSys);
if (nLocals >= FICL_MAX_LOCALS)
{vmThrowErr(pVM, "Error: out of local space");
@@ -4064,7 +4076,7 @@
FICL_WORD *pFW;
if (!pQuit)
- pQuit = ficlLookup("exit-inner");+ pQuit = ficlLookup(pVM->pSys, "exit-inner");
assert(pVM);
assert(pQuit);
@@ -4478,20 +4490,20 @@
/*
** Set CORE environment query values
*/
- ficlSetEnv("/counted-string", FICL_STRING_MAX);- ficlSetEnv("/hold", nPAD);- ficlSetEnv("/pad", nPAD);- ficlSetEnv("address-unit-bits", 8);- ficlSetEnv("core", FICL_TRUE);- ficlSetEnv("core-ext", FICL_FALSE);- ficlSetEnv("floored", FICL_FALSE);- ficlSetEnv("max-char", UCHAR_MAX);- ficlSetEnvD("max-d", 0x7fffffff, 0xffffffff );- ficlSetEnv("max-n", 0x7fffffff);- ficlSetEnv("max-u", 0xffffffff);- ficlSetEnvD("max-ud", 0xffffffff, 0xffffffff);- ficlSetEnv("return-stack-cells",FICL_DEFAULT_STACK);- ficlSetEnv("stack-cells", FICL_DEFAULT_STACK);+ ficlSetEnv(pSys, "/counted-string", FICL_STRING_MAX);
+ ficlSetEnv(pSys, "/hold", nPAD);
+ ficlSetEnv(pSys, "/pad", nPAD);
+ ficlSetEnv(pSys, "address-unit-bits", 8);
+ ficlSetEnv(pSys, "core", FICL_TRUE);
+ ficlSetEnv(pSys, "core-ext", FICL_FALSE);
+ ficlSetEnv(pSys, "floored", FICL_FALSE);
+ ficlSetEnv(pSys, "max-char", UCHAR_MAX);
+ ficlSetEnvD(pSys,"max-d", 0x7fffffff, 0xffffffff);
+ ficlSetEnv(pSys, "max-n", 0x7fffffff);
+ ficlSetEnv(pSys, "max-u", 0xffffffff);
+ ficlSetEnvD(pSys,"max-ud", 0xffffffff, 0xffffffff);
+ ficlSetEnv(pSys, "return-stack-cells",FICL_DEFAULT_STACK);
+ ficlSetEnv(pSys, "stack-cells", FICL_DEFAULT_STACK);
/*
** DOUBLE word set (partial)
@@ -4508,8 +4520,8 @@
dictAppendWord(dp, "catch", ficlCatch, FW_DEFAULT);
dictAppendWord(dp, "throw", ficlThrow, FW_DEFAULT);
- ficlSetEnv("exception", FICL_TRUE);- ficlSetEnv("exception-ext", FICL_TRUE);+ ficlSetEnv(pSys, "exception", FICL_TRUE);
+ ficlSetEnv(pSys, "exception-ext", FICL_TRUE);
/*
** LOCAL and LOCAL EXT
@@ -4541,9 +4553,9 @@
dictAppendWord(dp, "(to2Local)",to2LocalParen, FW_COMPILE);
dictAppendWord(dp, "(2local)", twoLocalParen, FW_COMPILE);
- ficlSetEnv("locals", FICL_TRUE);- ficlSetEnv("locals-ext", FICL_TRUE);- ficlSetEnv("#locals", FICL_MAX_LOCALS);+ ficlSetEnv(pSys, "locals", FICL_TRUE);
+ ficlSetEnv(pSys, "locals-ext", FICL_TRUE);
+ ficlSetEnv(pSys, "#locals", FICL_MAX_LOCALS);
#endif
/*
@@ -4554,8 +4566,8 @@
dictAppendWord(dp, "free", ansFree, FW_DEFAULT);
dictAppendWord(dp, "resize", ansResize, FW_DEFAULT);
- ficlSetEnv("memory-alloc", FICL_TRUE);- ficlSetEnv("memory-alloc-ext", FICL_FALSE);+ ficlSetEnv(pSys, "memory-alloc", FICL_TRUE);
+ ficlSetEnv(pSys, "memory-alloc-ext", FICL_FALSE);
/*
** optional SEARCH-ORDER word set