ref: e0e4c57d3f36eff21a3521c4568a4e545580da91
parent: 0a10ee45dab0f0730216621719bb61a99e6ecae8
author: jsadler <jsadler@ficl.sf.net>
date: Tue Nov 20 14:33:31 CST 2001
Removed DOS eol sequences (sorry) Minor mods to FICL_SYSTEM and FICL_VM. Re-ordered core words in words.c
--- a/ReadMe.txt
+++ b/ReadMe.txt
@@ -1,4 +1,18 @@
-rel 3.01 -- 2001
+debugger vocabulary - use ficlexec to do debug commands
+SYSTEM extension redirects STDOUT to window in ficlwin
+File regression suite
+
+Consolidated context and pExtend pointers of FICL_SYSTEM - VM's pExtend pointer
+ is initialized from the copy in FICL_SYSTEM upon VM creation.
+Ficlwin character handling is more robust
+SEE improvements - SEE (and consequently DEBUG) have improved source listings
+ with instruction offsets
+Corrected various bugs in docs.
+Added ficl-ized version of JV Noble's Forth Primer
+Ficlwin uses multi-system constructs (see ficlthread.c)
+MEMORY-EXT environment variable removed (there is no such wordset)
+
+rel 3.01 -- October 2001
Major contribs by Larry Hastings (larry@hastings.org)
- FILE wordset
--- 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.12 2001/11/05 02:09:28 jsadler Exp $
+** $Id: dict.c,v 1.13 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** This file implements the dictionary -- FICL's model of
--- 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.14 2001/11/05 02:09:28 jsadler Exp $
+** $Id: ficl.c,v 1.15 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** This is an ANS Forth interpreter written in C.
@@ -62,9 +62,9 @@
/*
** System statics
-** The system builds a global dictionary during its start
-** sequence. This is shared by all interpreter instances.
-** Therefore only one instance can update the dictionary
+** Each FICL_SYSTEM 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,
@@ -72,7 +72,6 @@
** and supply your own version of ficlLockDictionary.
*/
static int defaultStack = FICL_DEFAULT_STACK;
-static int defaultDict = FICL_DEFAULT_DICT;
static void ficlSetVersionEnv(FICL_SYSTEM *pSys);
@@ -91,23 +90,31 @@
**************************************************************************/
FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi)
{- int nDictCells = fsi->nDictCells;
+ int nDictCells;
+ int nEnvCells;
FICL_SYSTEM *pSys = ficlMalloc(sizeof (FICL_SYSTEM));
+
assert(pSys);
+ assert(fsi->size == sizeof (FICL_SYSTEM_INFO));
memset(pSys, 0, sizeof (FICL_SYSTEM));
+ nDictCells = fsi->nDictCells;
if (nDictCells <= 0)
- nDictCells = defaultDict;
+ nDictCells = FICL_DEFAULT_DICT;
+ nEnvCells = fsi->nEnvCells;
+ if (nEnvCells <= 0)
+ nEnvCells = FICL_DEFAULT_DICT;
+
pSys->dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE);
pSys->dp->pForthWords->name = "forth-wordlist";
- pSys->envp = dictCreate((unsigned)FICL_DEFAULT_ENV);
+ pSys->envp = dictCreate((unsigned)nEnvCells);
pSys->envp->pForthWords->name = "environment";
- pSys->textOut = fsi->textOut;
- pSys->context = fsi->context;
+ pSys->textOut = fsi->textOut;
+ pSys->pExtend = fsi->pExtend;
#if FICL_WANT_LOCALS
/*
@@ -148,11 +155,11 @@
/*
** 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...
+ ** 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(pSys);
ficlCompileSoftCore(pSys);
@@ -165,10 +172,10 @@
FICL_SYSTEM *ficlInitSystem(int nDictCells)
{- FICL_SYSTEM_INFO fsi;
- ficlInitInfo(&fsi);
- fsi.nDictCells = nDictCells;
- return ficlInitSystemEx(&fsi);
+ FICL_SYSTEM_INFO fsi;
+ ficlInitInfo(&fsi);
+ fsi.nDictCells = nDictCells;
+ return ficlInitSystemEx(&fsi);
}
@@ -243,7 +250,8 @@
FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack);
pVM->link = pSys->vmList;
pVM->pSys = pSys;
- vmSetTextOut(pVM, pSys->textOut);
+ pVM->pExtend = pSys->pExtend;
+ vmSetTextOut(pVM, pSys->textOut);
pSys->vmList = pVM;
return pVM;
@@ -259,7 +267,7 @@
**************************************************************************/
void ficlFreeVM(FICL_VM *pVM)
{- FICL_SYSTEM *pSys = pVM->pSys;
+ FICL_SYSTEM *pSys = pVM->pSys;
FICL_VM *pList = pSys->vmList;
assert(pVM != 0);
@@ -316,7 +324,7 @@
/**************************************************************************
f i c l E v a l u a t e
** Wrapper for ficlExec() which sets SOURCE-ID to -1.
-*/
+**************************************************************************/
int ficlEvaluate(FICL_VM *pVM, char *pText)
{int returnValue;
@@ -353,7 +361,7 @@
int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
{- FICL_SYSTEM *pSys = pVM->pSys;
+ FICL_SYSTEM *pSys = pVM->pSys;
FICL_DICT *dp = pSys->dp;
int except;
--- a/ficl.dsp
+++ b/ficl.dsp
@@ -93,6 +93,15 @@
# Begin Source File
SOURCE=.\ficl.c
+
+!IF "$(CFG)" == "ficl - Win32 Release"
+
+# ADD CPP /FAcs
+
+!ELSEIF "$(CFG)" == "ficl - Win32 Debug"
+
+!ENDIF
+
# End Source File
# Begin Source File
@@ -241,6 +250,10 @@
# End Source File
# Begin Source File
+SOURCE=.\doc\ficl_ans.html
+# End Source File
+# Begin Source File
+
SOURCE=.\doc\ficl_debug.html
# End Source File
# Begin Source File
@@ -282,7 +295,7 @@
# End Group
# Begin Source File
-SOURCE=..\ReadMe.txt
+SOURCE=.\ReadMe.txt
# End Source File
# End Target
# End Project
--- a/ficl.h
+++ b/ficl.h
@@ -4,7 +4,7 @@
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 19 July 1997
** Dedicated to RHS, in loving memory
-** $Id: ficl.h,v 1.16 2001/11/05 02:09:28 jsadler Exp $
+** $Id: ficl.h,v 1.17 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -122,10 +122,7 @@
** T o D o L i s t
**
** 1. Unimplemented system dependent CORE word: key
-** 2. Kludged CORE word: ACCEPT
-** 3. Dictionary locking is full of holes - only one vm at a time
-** can alter the dict.
-** 4. Ficl uses the pad in CORE words - this violates the standard,
+** 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.
**
@@ -151,7 +148,7 @@
** - Make the main hash table a bigger prime (HASHSIZE)
** - FORGET about twiddling the hash function - my experience is
** that that is a waste of time.
-** - eliminate the need to pass the pVM parameter on the stack
+** - Eliminate the need to pass the pVM parameter on the stack
** by dedicating a register to it. Most words need access to the
** vm, but the parameter passing overhead can be reduced. One way
** requires that the host OS have a task switch callout. Create
@@ -257,7 +254,8 @@
/*
** A CELL 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 i and u.
+** 32 bit and 64 bit processors, use abstract types for int,
+** unsigned, and float.
*/
typedef union _cell
{@@ -474,11 +472,10 @@
struct vm
{FICL_SYSTEM *pSys; /* Which system this VM belongs to */
- void *context; /* Not used by FICL--use this for your own data */
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 */
+ void * pExtend; /* vm extension pointer for app use - initialized from FICL_SYSTEM */
short fRestart; /* Set TRUE to restart runningWord */
IPTYPE ip; /* instruction pointer */
FICL_WORD *runningWord;/* address of currently running word (often just *(ip-1) ) */
@@ -601,7 +598,7 @@
#define M_VM_STEP(pVM) \
FICL_WORD *tempFW = *(pVM)->ip++; \
(pVM)->runningWord = tempFW; \
- tempFW->code(pVM); \
+ tempFW->code(pVM);
#define M_INNER_LOOP(pVM) \
for (;;) { M_VM_STEP(pVM) }@@ -834,11 +831,13 @@
** to separate dictionaries with some constraints.
** The present model allows multiple sessions to one dictionary provided
** you implement ficlLockDictionary() as specified in sysdep.h
+** Note: the pExtend pointer is there to provide context for applications. It is copied
+** to each VM's pExtend field as that VM is created.
*/
struct ficl_system
{FICL_SYSTEM *link;
- void *context; /* Not used by FICL--use this for your own data */
+ void *pExtend; /* Initializes VM's pExtend pointer (for application use) */
FICL_VM *vmList;
FICL_DICT *dp;
FICL_DICT *envp;
@@ -886,10 +885,11 @@
struct ficl_system_info
{- int size;
- int nDictCells;
- OUTFUNC textOut;
- void *context;
+ int size; /* structure size tag for versioning */
+ int nDictCells; /* Size of system's Dictionary */
+ OUTFUNC textOut; /* default textOut function */
+ void *pExtend; /* Initializes VM's pExtend pointer - for application use */
+ int nEnvCells; /* Size of Environment dictionary */
};
--- 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.6 2001/11/05 02:09:28 jsadler Exp $
+** $Id: float.c,v 1.7 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -991,33 +991,49 @@
assert(dp);
#if FICL_WANT_FLOAT
+ dictAppendWord(dp, ">float", ToF, FW_DEFAULT);
+ /* d>f */
dictAppendWord(dp, "f!", Fstore, FW_DEFAULT);
- dictAppendWord(dp, "f?dup", FquestionDup, FW_DEFAULT);
+ dictAppendWord(dp, "f*", Fmul, FW_DEFAULT);
+ dictAppendWord(dp, "f+", Fadd, FW_DEFAULT);
+ dictAppendWord(dp, "f-", Fsub, FW_DEFAULT);
+ dictAppendWord(dp, "f/", Fdiv, FW_DEFAULT);
+ dictAppendWord(dp, "f0<", FzeroLess, FW_DEFAULT);
+ dictAppendWord(dp, "f0=", FzeroEquals, FW_DEFAULT);
+ dictAppendWord(dp, "f<", FisLess, FW_DEFAULT);
+ /*
+ f>d
+ */
dictAppendWord(dp, "f@", Ffetch, FW_DEFAULT);
+ /*
+ falign
+ faligned
+ */
+ dictAppendWord(dp, "fconstant", Fconstant, FW_DEFAULT);
+ dictAppendWord(dp, "fdepth", Fdepth, FW_DEFAULT);
+ dictAppendWord(dp, "fdrop", Fdrop, FW_DEFAULT);
+ dictAppendWord(dp, "fdup", Fdup, FW_DEFAULT);
+ dictAppendWord(dp, "fliteral", fliteralIm, FW_IMMEDIATE);
+/*
+ float+
+ floats
+ floor
+ fmax
+ fmin
+*/
+ dictAppendWord(dp, "f?dup", FquestionDup, FW_DEFAULT);
dictAppendWord(dp, "f=", FisEqual, FW_DEFAULT);
- dictAppendWord(dp, "f<", FisLess, FW_DEFAULT);
dictAppendWord(dp, "f>", FisGreater, FW_DEFAULT);
- dictAppendWord(dp, "f0=", FzeroEquals, FW_DEFAULT);
- dictAppendWord(dp, "f0<", FzeroLess, FW_DEFAULT);
dictAppendWord(dp, "f0>", FzeroGreater, FW_DEFAULT);
dictAppendWord(dp, "f2drop", FtwoDrop, FW_DEFAULT);
dictAppendWord(dp, "f2dup", FtwoDup, FW_DEFAULT);
dictAppendWord(dp, "f2over", FtwoOver, FW_DEFAULT);
dictAppendWord(dp, "f2swap", FtwoSwap, FW_DEFAULT);
- dictAppendWord(dp, "f+", Fadd, FW_DEFAULT);
dictAppendWord(dp, "f+!", FplusStore, FW_DEFAULT);
- dictAppendWord(dp, "f-", Fsub, FW_DEFAULT);
- dictAppendWord(dp, "f*", Fmul, FW_DEFAULT);
- dictAppendWord(dp, "f/", Fdiv, FW_DEFAULT);
dictAppendWord(dp, "f+i", Faddi, FW_DEFAULT);
dictAppendWord(dp, "f-i", Fsubi, FW_DEFAULT);
dictAppendWord(dp, "f*i", Fmuli, FW_DEFAULT);
dictAppendWord(dp, "f/i", Fdivi, FW_DEFAULT);
- dictAppendWord(dp, "fconstant", Fconstant, FW_DEFAULT);
- dictAppendWord(dp, "fdepth", Fdepth, FW_DEFAULT);
- dictAppendWord(dp, "fdrop", Fdrop, FW_DEFAULT);
- dictAppendWord(dp, "fdup", Fdup, FW_DEFAULT);
- dictAppendWord(dp, "fliteral", fliteralIm, FW_IMMEDIATE);
dictAppendWord(dp, "int>float", itof, FW_DEFAULT);
dictAppendWord(dp, "float>int", Ftoi, FW_DEFAULT);
dictAppendWord(dp, "f.", FDot, FW_DEFAULT);
@@ -1032,8 +1048,7 @@
dictAppendWord(dp, "i-f", isubf, FW_DEFAULT);
dictAppendWord(dp, "i/f", idivf, FW_DEFAULT);
- dictAppendWord(dp, "f>", FFrom, FW_DEFAULT);
- dictAppendWord(dp, ">f", ToF, FW_DEFAULT);
+ dictAppendWord(dp, "float>", FFrom, FW_DEFAULT);
dictAppendWord(dp, "f-roll", FminusRoll, FW_DEFAULT);
dictAppendWord(dp, "f-rot", Fminusrot, FW_DEFAULT);
--- a/math64.c
+++ b/math64.c
@@ -5,7 +5,7 @@
** Created: 25 January 1998
** Rev 2.03: Support for 128 bit DP math. This file really ouught to
** be renamed!
-** $Id: math64.c,v 1.7 2001/11/05 02:09:28 jsadler Exp $
+** $Id: math64.c,v 1.8 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
--- a/math64.h
+++ b/math64.h
@@ -3,7 +3,7 @@
** Forth Inspired Command Language - 64 bit math support routines
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 25 January 1998
-** $Id: math64.h,v 1.7 2001/11/05 02:09:28 jsadler Exp $
+** $Id: math64.h,v 1.8 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
--- 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.4 2001/11/05 02:09:28 jsadler Exp $
+** $Id: prefix.c,v 1.5 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
--- 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.7 2001/11/05 02:09:28 jsadler Exp $
+** $Id: search.c,v 1.8 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
--- 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.8 2001/11/05 02:09:28 jsadler Exp $
+** $Id: stack.c,v 1.9 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
--- a/sysdep.c
+++ b/sysdep.c
@@ -6,7 +6,7 @@
** Implementations of FICL external interface functions...
**
** (simple) port to Linux, Skip Carter 26 March 1998
-** $Id: sysdep.c,v 1.10 2001/11/05 02:09:28 jsadler Exp $
+** $Id: sysdep.c,v 1.11 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
--- a/sysdep.h
+++ b/sysdep.h
@@ -9,7 +9,7 @@
** FICL_ROBUST is enabled. This may require some consideration
** in firmware systems since assert often
** assumes stderr/stdout.
-** $Id: sysdep.h,v 1.9 2001/11/08 16:33:38 jsadler Exp $
+** $Id: sysdep.h,v 1.10 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -54,24 +54,24 @@
#include <assert.h>
#if defined(_WIN32)
- #include <stdio.h>
- #ifndef alloca
- #define alloca(x) _alloca(x)
- #endif /* alloca */
+ #include <stdio.h>
+ #ifndef alloca
+ #define alloca(x) _alloca(x)
+ #endif /* alloca */
#define fstat _fstat
- #define stat _stat
- #define getcwd _getcwd
- #define chdir _chdir
- #define unlink _unlink
- #define fileno _fileno
+ #define stat _stat
+ #define getcwd _getcwd
+ #define chdir _chdir
+ #define unlink _unlink
+ #define fileno _fileno
- #define FICL_HAVE_FTRUNCATE 1
- extern int ftruncate(int fileno, size_t size);
+ #define FICL_HAVE_FTRUNCATE 1
+ extern int ftruncate(int fileno, size_t size);
#elif defined(linux)
- #define FICL_HAVE_FTRUNCATE 1
+ #define FICL_HAVE_FTRUNCATE 1
#endif /* platform */
-#if !defined IGNORE /* Macro to silence unused param warnings */
+#if !defined IGNORE /* Macro to silence unused param warnings */
#define IGNORE(x) &x
#endif
--- a/testmain.c
+++ b/testmain.c
@@ -1,6 +1,6 @@
/*
** stub main for testing FICL under Win32
-** $Id: testmain.c,v 1.11 2001/11/05 02:09:28 jsadler Exp $
+** $Id: testmain.c,v 1.12 2001/11/20 20:33:31 jsadler Exp $
*/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
--- 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.9 2001/11/05 02:09:28 jsadler Exp $
+** $Id: tools.c,v 1.10 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -92,7 +92,7 @@
**************************************************************************/
static void debugPrompt(FICL_VM *pVM)
{- vmTextOut(pVM, FICL_PROMPT, 0);
+ vmTextOut(pVM, "dbg> ", 0);
}
@@ -126,11 +126,13 @@
}
+#if 0
static int isPrimitive(FICL_WORD *pFW)
{WORDKIND wk = ficlWordClassify(pFW);
return ((wk != COLON) && (wk != DOES));
}
+#endif
/**************************************************************************
@@ -178,7 +180,8 @@
*/
static void seeColon(FICL_VM *pVM, CELL *pc)
{- char *cp = pVM->pad + 1;
+ char *cp;
+ CELL *param0 = pc;
FICL_DICT *pd = vmGetDict(pVM);
FICL_WORD *pSemiParen = ficlLookup(pVM->pSys, "(;)");
assert(pSemiParen);
@@ -187,16 +190,18 @@
{FICL_WORD *pFW = (FICL_WORD *)(pc->p);
+ cp = pVM->pad;
+ if ((void *)pc == (void *)pVM->ip)
+ *cp++ = '>';
+ else
+ *cp++ = ' ';
+ cp += sprintf(cp, "%3d ", pc-param0);
+
if (isAFiclWord(pd, pFW))
{WORDKIND kind = ficlWordClassify(pFW);
CELL c;
- if ((void *)pc == (void *)pVM->ip)
- cp[-1] = '>';
- else
- cp[-1] = ' ';
-
switch (kind)
{case LITERAL:
@@ -204,17 +209,17 @@
if (isAFiclWord(pd, c.p))
{FICL_WORD *pLit = (FICL_WORD *)c.p;
- sprintf(cp, " literal %.*s (%#lx)",
+ sprintf(cp, "%.*s ( %#lx literal )",
pLit->nName, pLit->name, c.u);
}
else
- sprintf(cp, " literal %ld (%#lx)", c.i, c.u);
+ sprintf(cp, "literal %ld (%#lx)", c.i, c.u);
break;
case STRINGLIT:
{FICL_STRING *sp = (FICL_STRING *)(void *)++pc;
pc = (CELL *)alignPtr(sp->text + sp->count + 1) - 1;
- sprintf(cp, " s\" %.*s\"", sp->count, sp->text);
+ sprintf(cp, "s\" %.*s\"", sp->count, sp->text);
}
break;
case CSTRINGLIT:
@@ -221,42 +226,42 @@
{FICL_STRING *sp = (FICL_STRING *)(void *)++pc;
pc = (CELL *)alignPtr(sp->text + sp->count + 1) - 1;
- sprintf(cp, " c\" %.*s\"", sp->count, sp->text);
+ sprintf(cp, "c\" %.*s\"", sp->count, sp->text);
}
break;
case IF:
c = *++pc;
if (c.i > 0)
- sprintf(cp, " if / while (branch rel %ld)", c.i);
+ sprintf(cp, "if / while (branch %d)", pc+c.i-param0);
else
- sprintf(cp, " until (branch rel %ld)", c.i);
- break;
+ sprintf(cp, "until (branch %d)", pc+c.i-param0);
+ break;
case BRANCH:
c = *++pc;
if (c.i > 0)
- sprintf(cp, " else (branch rel %ld)", c.i);
+ sprintf(cp, "else (branch %d)", pc+c.i-param0);
else
- sprintf(cp, " repeat (branch rel %ld)", c.i);
+ sprintf(cp, "repeat (branch %d)", pc+c.i-param0);
break;
case QDO:
c = *++pc;
- sprintf(cp, " ?do (leave abs %#lx)", c.u);
+ sprintf(cp, "?do (leave %d)", (CELL *)c.p-param0);
break;
case DO:
c = *++pc;
- sprintf(cp, " do (leave abs %#lx)", c.u);
+ sprintf(cp, "do (leave %d)", (CELL *)c.p-param0);
break;
case LOOP:
c = *++pc;
- sprintf(cp, " loop (branch rel %#ld)", c.i);
+ sprintf(cp, "loop (branch %d)", pc+c.i-param0);
break;
case PLOOP:
c = *++pc;
- sprintf(cp, " +loop (branch rel %#ld)", c.i);
+ sprintf(cp, "+loop (branch %d)", pc+c.i-param0);
break;
default:
- sprintf(cp, " %.*s", pFW->nName, pFW->name);
+ sprintf(cp, "%.*s", pFW->nName, pFW->name);
break;
}
@@ -263,7 +268,7 @@
}
else /* probably not a word - punt and print value */
{- sprintf(cp, " %ld (%#lx)", pc->i, pc->u);
+ sprintf(cp, "%ld ( %#lx )", pc->i, pc->u);
}
vmTextOut(pVM, pVM->pad, 1);
@@ -494,10 +499,12 @@
*/
pFW = pVM->pSys->bpStep.origXT;
sprintf(pVM->pad, "next: %.*s", pFW->nName, pFW->name);
+#if 0
if (isPrimitive(pFW))
{- strcat(pVM->pad, " primitive");
+ strcat(pVM->pad, " ( primitive )");
}
+#endif
vmTextOut(pVM, pVM->pad, 1);
debugPrompt(pVM);
--- a/unix.c
+++ b/unix.c
@@ -1,5 +1,4 @@
#include <string.h>
-#include <sys/types.h>
#include <netinet/in.h>
#include "ficl.h"
--- 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.11 2001/11/05 02:09:28 jsadler Exp $
+** $Id: vm.c,v 1.12 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** This file implements the virtual machine of FICL. Each virtual
@@ -157,6 +157,7 @@
M_INNER_LOOP(pVM);
}
#endif
+
/**************************************************************************
--- 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.15 2001/11/05 02:09:28 jsadler Exp $
+** $Id: words.c,v 1.16 2001/11/20 20:33:31 jsadler Exp $
*******************************************************************/
/*
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
@@ -4601,7 +4601,6 @@
dictAppendWord(dp, "/mod", slashMod, FW_DEFAULT);
dictAppendWord(dp, "0<", zeroLess, FW_DEFAULT);
dictAppendWord(dp, "0=", zeroEquals, FW_DEFAULT);
- dictAppendWord(dp, "0>", zeroGreater, FW_DEFAULT);
dictAppendWord(dp, "1+", onePlus, FW_DEFAULT);
dictAppendWord(dp, "1-", oneMinus, FW_DEFAULT);
dictAppendWord(dp, "2!", twoStore, FW_DEFAULT);
@@ -4633,7 +4632,6 @@
dictAppendWord(dp, "base", base, FW_DEFAULT);
dictAppendWord(dp, "begin", beginCoIm, FW_COMPIMMED);
dictAppendWord(dp, "c!", cStore, FW_DEFAULT);
- dictAppendWord(dp, "c\"", cstringQuoteIm, FW_IMMEDIATE);
dictAppendWord(dp, "c,", cComma, FW_DEFAULT);
dictAppendWord(dp, "c@", cFetch, FW_DEFAULT);
dictAppendWord(dp, "cell+", cellPlus, FW_DEFAULT);
@@ -4661,7 +4659,6 @@
dictAppendWord(dp, "find", cFind, FW_DEFAULT);
dictAppendWord(dp, "fm/mod", fmSlashMod, FW_DEFAULT);
dictAppendWord(dp, "here", here, FW_DEFAULT);
- dictAppendWord(dp, "hex", hex, FW_DEFAULT);
dictAppendWord(dp, "hold", hold, FW_DEFAULT);
dictAppendWord(dp, "i", loopICo, FW_COMPILE);
dictAppendWord(dp, "if", ifCoIm, FW_COMPIMMED);
@@ -4681,7 +4678,6 @@
dictAppendWord(dp, "negate", negate, FW_DEFAULT);
dictAppendWord(dp, "or", bitwiseOr, FW_DEFAULT);
dictAppendWord(dp, "over", over, FW_DEFAULT);
- dictAppendWord(dp, "pad", pad, FW_DEFAULT);
dictAppendWord(dp, "postpone", postponeCoIm, FW_COMPIMMED);
dictAppendWord(dp, "quit", quit, FW_DEFAULT);
dictAppendWord(dp, "r>", fromRStack, FW_COMPILE);
@@ -4717,15 +4713,23 @@
** CORE EXT word set...
** see softcore.fr for other definitions
*/
+ /* "#tib" */
dictAppendWord(dp, ".(", dotParen, FW_IMMEDIATE);- dictAppendWord(dp, ":noname", colonNoName, FW_DEFAULT);
+ /* ".r" */
+ dictAppendWord(dp, "0>", zeroGreater, FW_DEFAULT);
dictAppendWord(dp, "2>r", twoToR, FW_COMPILE);
dictAppendWord(dp, "2r>", twoRFrom, FW_COMPILE);
dictAppendWord(dp, "2r@", twoRFetch, FW_COMPILE);
+ dictAppendWord(dp, ":noname", colonNoName, FW_DEFAULT);
dictAppendWord(dp, "?do", qDoCoIm, FW_COMPIMMED);
dictAppendWord(dp, "again", againCoIm, FW_COMPIMMED);
+ dictAppendWord(dp, "c\"", cstringQuoteIm, FW_IMMEDIATE);
+ /* case of endof endcase */
+ dictAppendWord(dp, "hex", hex, FW_DEFAULT);
+ dictAppendWord(dp, "pad", pad, FW_DEFAULT);
dictAppendWord(dp, "parse", parse, FW_DEFAULT);
dictAppendWord(dp, "pick", pick, FW_DEFAULT);
+ /* query restore-input save-input tib u.r u> unused [compile] */
dictAppendWord(dp, "roll", roll, FW_DEFAULT);
dictAppendWord(dp, "refill", refill, FW_DEFAULT);
dictAppendWord(dp, "source-id", sourceid, FW_DEFAULT);
@@ -4814,7 +4818,6 @@
dictAppendWord(dp, "resize", ansResize, FW_DEFAULT);
ficlSetEnv(pSys, "memory-alloc", FICL_TRUE);
- ficlSetEnv(pSys, "memory-alloc-ext", FICL_FALSE);
/*
** optional SEARCH-ORDER word set