socsvn commit: r287788 - in soc2015/clord/head/sys/contrib/ficl: . softcore
clord at FreeBSD.org
clord at FreeBSD.org
Tue Jun 30 21:23:02 UTC 2015
Author: clord
Date: Tue Jun 30 21:23:01 2015
New Revision: 287788
URL: http://svnweb.FreeBSD.org/socsvn/?view=rev&rev=287788
Log:
Update files to Ficl 4 that were missed in the merge process
Added:
soc2015/clord/head/sys/contrib/ficl/softcore/ficl.fr (props changed)
- copied unchanged from r287787, mirror/FreeBSD/vendor/ficl/dist/softcore/ficl.fr
soc2015/clord/head/sys/contrib/ficl/softcore/make.bat (props changed)
- copied unchanged from r287787, mirror/FreeBSD/vendor/ficl/dist/softcore/make.bat
soc2015/clord/head/sys/contrib/ficl/softcore/makefile (props changed)
- copied unchanged from r287787, mirror/FreeBSD/vendor/ficl/dist/softcore/makefile
soc2015/clord/head/sys/contrib/ficl/softcore/makesoftcore.c (props changed)
- copied unchanged from r287787, mirror/FreeBSD/vendor/ficl/dist/softcore/makesoftcore.c
Modified:
soc2015/clord/head/sys/contrib/ficl/dictionary.c
soc2015/clord/head/sys/contrib/ficl/double.c
soc2015/clord/head/sys/contrib/ficl/primitives.c
soc2015/clord/head/sys/contrib/ficl/softcore/classes.fr
soc2015/clord/head/sys/contrib/ficl/softcore/ficlclass.fr
soc2015/clord/head/sys/contrib/ficl/softcore/ficllocal.fr
soc2015/clord/head/sys/contrib/ficl/softcore/fileaccess.fr
soc2015/clord/head/sys/contrib/ficl/softcore/forml.fr
soc2015/clord/head/sys/contrib/ficl/softcore/ifbrack.fr
soc2015/clord/head/sys/contrib/ficl/softcore/jhlocal.fr
soc2015/clord/head/sys/contrib/ficl/softcore/marker.fr
soc2015/clord/head/sys/contrib/ficl/softcore/oo.fr
soc2015/clord/head/sys/contrib/ficl/softcore/prefix.fr
soc2015/clord/head/sys/contrib/ficl/softcore/softcore.fr
soc2015/clord/head/sys/contrib/ficl/softcore/string.fr
soc2015/clord/head/sys/contrib/ficl/system.c
Modified: soc2015/clord/head/sys/contrib/ficl/dictionary.c
==============================================================================
--- soc2015/clord/head/sys/contrib/ficl/dictionary.c Tue Jun 30 20:59:07 2015 (r287787)
+++ soc2015/clord/head/sys/contrib/ficl/dictionary.c Tue Jun 30 21:23:01 2015 (r287788)
@@ -3,13 +3,13 @@
** Forth Inspired Command Language - dictionary methods
** Author: John Sadler (john_sadler at alum.mit.edu)
** Created: 19 July 1997
-** $Id: dict.c,v 1.14 2001/12/05 07:21:34 jsadler Exp $
+** $Id: dictionary.c,v 1.2 2010/09/12 15:14:52 asau Exp $
*******************************************************************/
/*
-** This file implements the dictionary -- FICL's model of
-** memory management. All FICL words are stored in the
+** This file implements the dictionary -- Ficl's model of
+** memory management. All Ficl words are stored in the
** dictionary. A word is a named chunk of data with its
-** associated code. FICL treats all words the same, even
+** associated code. Ficl treats all words the same, even
** precompiled ones, so your words become first-class
** extensions of the language. You can even define new
** control structures.
@@ -22,9 +22,9 @@
**
** Get the latest Ficl release at http://ficl.sourceforge.net
**
-** I am interested in hearing from anyone who uses ficl. If you have
+** I am interested in hearing from anyone who uses Ficl. If you have
** a problem, a success story, a defect, an enhancement request, or
-** if you would like to contribute to the ficl release, please
+** if you would like to contribute to the Ficl release, please
** contact me by email at the address above.
**
** L I C E N S E and D I S C L A I M E R
@@ -51,23 +51,16 @@
** SUCH DAMAGE.
*/
-/* $FreeBSD$ */
-
-#ifdef TESTMAIN
-#include <stdio.h>
#include <ctype.h>
-#else
-#include <stand.h>
-#endif
+#include <stdio.h>
+#include <stdlib.h>
#include <string.h>
-#include "ficl.h"
-
-/* Dictionary on-demand resizing control variables */
-CELL dictThreshold;
-CELL dictIncrease;
+#include "ficl.h"
-static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si);
+#define FICL_SAFE_CALLBACK_FROM_SYSTEM(system) (((system) != NULL) ? &((system)->callback) : NULL)
+#define FICL_SAFE_SYSTEM_FROM_DICTIONARY(dictionary) (((dictionary) != NULL) ? (dictionary)->system : NULL)
+#define FICL_DICTIONARY_ASSERT(dictionary, expression) FICL_SYSTEM_ASSERT(FICL_SAFE_SYSTEM_FROM_DICTIONARY(dictionary), expression)
/**************************************************************************
d i c t A b o r t D e f i n i t i o n
@@ -79,46 +72,27 @@
** only works for defs in process. If the def has been unsmudged,
** nothing happens.
**************************************************************************/
-void dictAbortDefinition(FICL_DICT *pDict)
+void ficlDictionaryAbortDefinition(ficlDictionary *dictionary)
{
- FICL_WORD *pFW;
- ficlLockDictionary(TRUE);
- pFW = pDict->smudge;
+ ficlWord *word;
+ ficlDictionaryLock(dictionary, FICL_TRUE);
+ word = dictionary->smudge;
- if (pFW->flags & FW_SMUDGE)
- pDict->here = (CELL *)pFW->name;
+ if (word->flags & FICL_WORD_SMUDGED)
+ dictionary->here = (ficlCell *)word->name;
- ficlLockDictionary(FALSE);
+ ficlDictionaryLock(dictionary, FICL_FALSE);
return;
}
/**************************************************************************
- a l i g n P t r
-** Aligns the given pointer to FICL_ALIGN address units.
-** Returns the aligned pointer value.
-**************************************************************************/
-void *alignPtr(void *ptr)
-{
-#if FICL_ALIGN > 0
- char *cp;
- CELL c;
- cp = (char *)ptr + FICL_ALIGN_ADD;
- c.p = (void *)cp;
- c.u = c.u & (~FICL_ALIGN_ADD);
- ptr = (CELL *)c.p;
-#endif
- return ptr;
-}
-
-
-/**************************************************************************
d i c t A l i g n
** Align the dictionary's free space pointer
**************************************************************************/
-void dictAlign(FICL_DICT *pDict)
+void ficlDictionaryAlign(ficlDictionary *dictionary)
{
- pDict->here = alignPtr(pDict->here);
+ dictionary->here = ficlAlignPointer(dictionary->here);
}
@@ -127,70 +101,32 @@
** Allocate or remove n chars of dictionary space, with
** checks for underrun and overrun
**************************************************************************/
-int dictAllot(FICL_DICT *pDict, int n)
+void ficlDictionaryAllot(ficlDictionary *dictionary, int n)
{
- char *cp = (char *)pDict->here;
-#if FICL_ROBUST
- if (n > 0)
- {
- if ((unsigned)n <= dictCellsAvail(pDict) * sizeof (CELL))
- cp += n;
- else
- return 1; /* dict is full */
- }
- else
- {
- n = -n;
- if ((unsigned)n <= dictCellsUsed(pDict) * sizeof (CELL))
- cp -= n;
- else /* prevent underflow */
- cp -= dictCellsUsed(pDict) * sizeof (CELL);
- }
-#else
- cp += n;
-#endif
- pDict->here = PTRtoCELL cp;
- return 0;
+ char *here = (char *)dictionary->here;
+ here += n;
+ dictionary->here = FICL_POINTER_TO_CELL(here);
}
/**************************************************************************
d i c t A l l o t C e l l s
-** Reserve space for the requested number of cells in the
-** dictionary. If nCells < 0 , removes space from the dictionary.
+** Reserve space for the requested number of ficlCells in the
+** dictionary. If nficlCells < 0 , removes space from the dictionary.
**************************************************************************/
-int dictAllotCells(FICL_DICT *pDict, int nCells)
+void ficlDictionaryAllotCells(ficlDictionary *dictionary, int nficlCells)
{
-#if FICL_ROBUST
- if (nCells > 0)
- {
- if (nCells <= dictCellsAvail(pDict))
- pDict->here += nCells;
- else
- return 1; /* dict is full */
- }
- else
- {
- nCells = -nCells;
- if (nCells <= dictCellsUsed(pDict))
- pDict->here -= nCells;
- else /* prevent underflow */
- pDict->here -= dictCellsUsed(pDict);
- }
-#else
- pDict->here += nCells;
-#endif
- return 0;
+ dictionary->here += nficlCells;
}
/**************************************************************************
d i c t A p p e n d C e l l
-** Append the specified cell to the dictionary
+** Append the specified ficlCell to the dictionary
**************************************************************************/
-void dictAppendCell(FICL_DICT *pDict, CELL c)
+void ficlDictionaryAppendCell(ficlDictionary *dictionary, ficlCell c)
{
- *pDict->here++ = c;
+ *dictionary->here++ = c;
return;
}
@@ -199,207 +135,333 @@
d i c t A p p e n d C h a r
** Append the specified char to the dictionary
**************************************************************************/
-void dictAppendChar(FICL_DICT *pDict, char c)
+void ficlDictionaryAppendCharacter(ficlDictionary *dictionary, char c)
{
- char *cp = (char *)pDict->here;
- *cp++ = c;
- pDict->here = PTRtoCELL cp;
+ char *here = (char *)dictionary->here;
+ *here++ = c;
+ dictionary->here = FICL_POINTER_TO_CELL(here);
return;
}
/**************************************************************************
- d i c t A p p e n d W o r d
-** Create a new word in the dictionary with the specified
-** name, code, and flags. Name must be NULL-terminated.
+ d i c t A p p e n d U N S
+** Append the specified ficlUnsigned to the dictionary
**************************************************************************/
-FICL_WORD *dictAppendWord(FICL_DICT *pDict,
- char *name,
- FICL_CODE pCode,
- UNS8 flags)
+void ficlDictionaryAppendUnsigned(ficlDictionary *dictionary, ficlUnsigned u)
{
- STRINGINFO si;
- SI_SETLEN(si, strlen(name));
- SI_SETPTR(si, name);
- return dictAppendWord2(pDict, si, pCode, flags);
+ *dictionary->here++ = FICL_LVALUE_TO_CELL(u);
+ return;
}
-/**************************************************************************
- d i c t A p p e n d W o r d 2
-** Create a new word in the dictionary with the specified
-** STRINGINFO, code, and flags. Does not require a NULL-terminated
-** name.
-**************************************************************************/
-FICL_WORD *dictAppendWord2(FICL_DICT *pDict,
- STRINGINFO si,
- FICL_CODE pCode,
- UNS8 flags)
-{
- FICL_COUNT len = (FICL_COUNT)SI_COUNT(si);
- char *pName;
- FICL_WORD *pFW;
-
- ficlLockDictionary(TRUE);
+void *ficlDictionaryAppendData(ficlDictionary *dictionary, void *data, ficlInteger length)
+{
+ char *here = (char *)dictionary->here;
+ char *oldHere = here;
+ char *from = (char *)data;
+
+ if (length == 0)
+ {
+ ficlDictionaryAlign(dictionary);
+ return (char *)dictionary->here;
+ }
- /*
- ** NOTE: dictCopyName advances "here" as a side-effect.
- ** It must execute before pFW is initialized.
- */
- pName = dictCopyName(pDict, si);
- pFW = (FICL_WORD *)pDict->here;
- pDict->smudge = pFW;
- pFW->hash = hashHashCode(si);
- pFW->code = pCode;
- pFW->flags = (UNS8)(flags | FW_SMUDGE);
- pFW->nName = (char)len;
- pFW->name = pName;
- /*
- ** Point "here" to first cell of new word's param area...
- */
- pDict->here = pFW->param;
+ while (length)
+ {
+ *here++ = *from++;
+ length--;
+ }
- if (!(flags & FW_SMUDGE))
- dictUnsmudge(pDict);
+ *here++ = '\0';
- ficlLockDictionary(FALSE);
- return pFW;
+ dictionary->here = FICL_POINTER_TO_CELL(here);
+ ficlDictionaryAlign(dictionary);
+ return oldHere;
}
/**************************************************************************
- d i c t A p p e n d U N S
-** Append the specified FICL_UNS to the dictionary
+ d i c t C o p y N a m e
+** Copy up to FICL_NAME_LENGTH characters of the name specified by s into
+** the dictionary starting at "here", then NULL-terminate the name,
+** point "here" to the next available byte, and return the address of
+** the beginning of the name. Used by dictAppendWord.
+** N O T E S :
+** 1. "here" is guaranteed to be aligned after this operation.
+** 2. If the string has zero length, align and return "here"
**************************************************************************/
-void dictAppendUNS(FICL_DICT *pDict, FICL_UNS u)
+char *ficlDictionaryAppendString(ficlDictionary *dictionary, ficlString s)
{
- *pDict->here++ = LVALUEtoCELL(u);
- return;
+ void *data = FICL_STRING_GET_POINTER(s);
+ ficlInteger length = FICL_STRING_GET_LENGTH(s);
+
+ if (length > FICL_NAME_LENGTH)
+ length = FICL_NAME_LENGTH;
+
+ return ficlDictionaryAppendData(dictionary, data, length);
}
-/**************************************************************************
- d i c t C e l l s A v a i l
-** Returns the number of empty cells left in the dictionary
-**************************************************************************/
-int dictCellsAvail(FICL_DICT *pDict)
+ficlWord *ficlDictionaryAppendConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficlInteger value)
{
- return pDict->size - dictCellsUsed(pDict);
+ ficlWord *word = ficlDictionaryAppendWord(dictionary, name, (ficlPrimitive)instruction, FICL_WORD_DEFAULT);
+ if (word != NULL)
+ ficlDictionaryAppendUnsigned(dictionary, value);
+ return word;
}
-/**************************************************************************
- d i c t C e l l s U s e d
-** Returns the number of cells consumed in the dicionary
-**************************************************************************/
-int dictCellsUsed(FICL_DICT *pDict)
+ficlWord *ficlDictionaryAppend2ConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficl2Integer value)
{
- return pDict->here - pDict->dict;
+ ficlWord *word = ficlDictionaryAppendWord(dictionary, name, (ficlPrimitive)instruction, FICL_WORD_DEFAULT);
+ if (word != NULL)
+ {
+ ficlDictionaryAppendUnsigned(dictionary, FICL_2UNSIGNED_GET_HIGH(value));
+ ficlDictionaryAppendUnsigned(dictionary, FICL_2UNSIGNED_GET_LOW(value));
+ }
+ return word;
}
-/**************************************************************************
- d i c t C h e c k
-** Checks the dictionary for corruption and throws appropriate
-** errors.
-** Input: +n number of ADDRESS UNITS (not Cells) proposed to allot
-** -n number of ADDRESS UNITS proposed to de-allot
-** 0 just do a consistency check
-**************************************************************************/
-void dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int n)
+
+ficlWord *ficlDictionaryAppendConstant(ficlDictionary *dictionary, char *name, ficlInteger value)
{
- if ((n >= 0) && (dictCellsAvail(pDict) * (int)sizeof(CELL) < n))
+ ficlString s;
+ FICL_STRING_SET_FROM_CSTRING(s, name);
+ return ficlDictionaryAppendConstantInstruction(dictionary, s, ficlInstructionConstantParen, value);
+}
+
+
+
+ficlWord *ficlDictionaryAppend2Constant(ficlDictionary *dictionary, char *name, ficl2Integer value)
+{
+ ficlString s;
+ FICL_STRING_SET_FROM_CSTRING(s, name);
+ return ficlDictionaryAppend2ConstantInstruction(dictionary, s, ficlInstruction2ConstantParen, value);
+}
+
+
+
+ficlWord *ficlDictionarySetConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficlInteger value)
+{
+ ficlWord *word = ficlDictionaryLookup(dictionary, name);
+
+ if (word == NULL)
{
- vmThrowErr(pVM, "Error: dictionary full");
+ word = ficlDictionaryAppendConstantInstruction(dictionary, name, instruction, value);
}
-
- if ((n <= 0) && (dictCellsUsed(pDict) * (int)sizeof(CELL) < -n))
+ else
{
- vmThrowErr(pVM, "Error: dictionary underflow");
+ word->code = (ficlPrimitive)instruction;
+ word->param[0] = FICL_LVALUE_TO_CELL(value);
}
+ return word;
+}
- if (pDict->nLists > FICL_DEFAULT_VOCS)
- {
- dictResetSearchOrder(pDict);
- vmThrowErr(pVM, "Error: search order overflow");
+ficlWord *ficlDictionarySetConstant(ficlDictionary *dictionary, char *name, ficlInteger value)
+{
+ ficlString s;
+ FICL_STRING_SET_FROM_CSTRING(s, name);
+ return ficlDictionarySetConstantInstruction(dictionary, s, ficlInstructionConstantParen, value);
+}
+
+ficlWord *ficlDictionarySet2ConstantInstruction(ficlDictionary *dictionary, ficlString s, ficlInstruction instruction, ficl2Integer value)
+{
+ ficlWord *word;
+ word = ficlDictionaryLookup(dictionary, s);
+
+ /* only reuse the existing word if we're sure it has space for a 2constant */
+ if ((word != NULL) &&
+ ((((ficlInstruction)word->code) == ficlInstruction2ConstantParen)
+#if FICL_WANT_FLOAT
+ ||
+ (((ficlInstruction)word->code) == ficlInstructionF2ConstantParen)
+#endif /* FICL_WANT_FLOAT */
+ )
+ )
+ {
+ word->code = (ficlPrimitive)instruction;
+ word->param[0].u = FICL_2UNSIGNED_GET_HIGH(value);
+ word->param[1].u = FICL_2UNSIGNED_GET_LOW(value);
}
- else if (pDict->nLists < 0)
+ else
{
- dictResetSearchOrder(pDict);
- vmThrowErr(pVM, "Error: search order underflow");
+ word = ficlDictionaryAppend2ConstantInstruction(dictionary, s, instruction, value);
}
- return;
+ return word;
+}
+
+
+ficlWord *ficlDictionarySet2Constant(ficlDictionary *dictionary, char *name, ficl2Integer value)
+{
+ ficlString s;
+ FICL_STRING_SET_FROM_CSTRING(s, name);
+ return ficlDictionarySet2ConstantInstruction(dictionary, s, ficlInstruction2ConstantParen, value);
}
+ficlWord *ficlDictionarySetConstantString(ficlDictionary *dictionary, char *name, char *value)
+{
+ ficlString s;
+ ficl2Integer valueAs2Integer;
+ FICL_2INTEGER_SET(strlen(value), (intptr_t)value, valueAs2Integer);
+ FICL_STRING_SET_FROM_CSTRING(s, name);
+
+ return ficlDictionarySet2ConstantInstruction(dictionary, s, ficlInstruction2ConstantParen, valueAs2Integer);
+}
+
+
+
/**************************************************************************
- d i c t C o p y N a m e
-** Copy up to nFICLNAME characters of the name specified by si into
-** the dictionary starting at "here", then NULL-terminate the name,
-** point "here" to the next available byte, and return the address of
-** the beginning of the name. Used by dictAppendWord.
-** N O T E S :
-** 1. "here" is guaranteed to be aligned after this operation.
-** 2. If the string has zero length, align and return "here"
+ d i c t A p p e n d W o r d
+** Create a new word in the dictionary with the specified
+** ficlString, code, and flags. Does not require a NULL-terminated
+** name.
+**************************************************************************/
+ficlWord *ficlDictionaryAppendWord(ficlDictionary *dictionary,
+ ficlString name,
+ ficlPrimitive code,
+ ficlUnsigned8 flags)
+{
+ ficlUnsigned8 length = (ficlUnsigned8)FICL_STRING_GET_LENGTH(name);
+ char *nameCopy;
+ ficlWord *word;
+
+ ficlDictionaryLock(dictionary, FICL_TRUE);
+
+ /*
+ ** NOTE: ficlDictionaryAppendString advances "here" as a side-effect.
+ ** It must execute before word is initialized.
+ */
+ nameCopy = ficlDictionaryAppendString(dictionary, name);
+ word = (ficlWord *)dictionary->here;
+ dictionary->smudge = word;
+ word->hash = ficlHashCode(name);
+ word->code = code;
+ word->semiParen = ficlInstructionSemiParen;
+ word->flags = (ficlUnsigned8)(flags | FICL_WORD_SMUDGED);
+ word->length = length;
+ word->name = nameCopy;
+ /*
+ ** Point "here" to first ficlCell of new word's param area...
+ */
+ dictionary->here = word->param;
+
+ if (!(flags & FICL_WORD_SMUDGED))
+ ficlDictionaryUnsmudge(dictionary);
+
+ ficlDictionaryLock(dictionary, FICL_FALSE);
+ return word;
+}
+
+
+/**************************************************************************
+ d i c t A p p e n d W o r d
+** Create a new word in the dictionary with the specified
+** name, code, and flags. Name must be NULL-terminated.
**************************************************************************/
-static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si)
+ficlWord *ficlDictionaryAppendPrimitive(ficlDictionary *dictionary,
+ char *name,
+ ficlPrimitive code,
+ ficlUnsigned8 flags)
{
- char *oldCP = (char *)pDict->here;
- char *cp = oldCP;
- char *name = SI_PTR(si);
- int i = SI_COUNT(si);
+ ficlString s;
+ FICL_STRING_SET_FROM_CSTRING(s, name);
+ return ficlDictionaryAppendWord(dictionary, s, code, flags);
+}
+
- if (i == 0)
+ficlWord *ficlDictionarySetPrimitive(ficlDictionary *dictionary,
+ char *name,
+ ficlPrimitive code,
+ ficlUnsigned8 flags)
+{
+ ficlString s;
+ ficlWord *word;
+
+ FICL_STRING_SET_FROM_CSTRING(s, name);
+ word = ficlDictionaryLookup(dictionary, s);
+
+ if (word == NULL)
{
- dictAlign(pDict);
- return (char *)pDict->here;
+ word = ficlDictionaryAppendPrimitive(dictionary, name, code, flags);
}
-
- if (i > nFICLNAME)
- i = nFICLNAME;
-
- for (; i > 0; --i)
+ else
{
- *cp++ = *name++;
+ word->code = (ficlPrimitive)code;
+ word->flags = flags;
}
+ return word;
+}
- *cp++ = '\0';
- pDict->here = PTRtoCELL cp;
- dictAlign(pDict);
- return oldCP;
+ficlWord *ficlDictionaryAppendInstruction(ficlDictionary *dictionary,
+ char *name,
+ ficlInstruction i,
+ ficlUnsigned8 flags)
+{
+ return ficlDictionaryAppendPrimitive(dictionary, name, (ficlPrimitive)i, (ficlUnsigned8)(FICL_WORD_INSTRUCTION | flags));
+}
+
+ficlWord *ficlDictionarySetInstruction(ficlDictionary *dictionary,
+ char *name,
+ ficlInstruction i,
+ ficlUnsigned8 flags)
+{
+ return ficlDictionarySetPrimitive(dictionary, name, (ficlPrimitive)i, (ficlUnsigned8)(FICL_WORD_INSTRUCTION | flags));
}
/**************************************************************************
+ d i c t C e l l s A v a i l
+** Returns the number of empty ficlCells left in the dictionary
+**************************************************************************/
+int ficlDictionaryCellsAvailable(ficlDictionary *dictionary)
+{
+ return dictionary->size - ficlDictionaryCellsUsed(dictionary);
+}
+
+
+/**************************************************************************
+ d i c t C e l l s U s e d
+** Returns the number of ficlCells consumed in the dicionary
+**************************************************************************/
+int ficlDictionaryCellsUsed(ficlDictionary *dictionary)
+{
+ return dictionary->here - dictionary->base;
+}
+
+
+
+/**************************************************************************
d i c t C r e a t e
** Create and initialize a dictionary with the specified number
-** of cells capacity, and no hashing (hash size == 1).
+** of ficlCells capacity, and no hashing (hash size == 1).
**************************************************************************/
-FICL_DICT *dictCreate(unsigned nCells)
+ficlDictionary *ficlDictionaryCreate(ficlSystem *system, unsigned size)
{
- return dictCreateHashed(nCells, 1);
+ return ficlDictionaryCreateHashed(system, size, 1);
}
-FICL_DICT *dictCreateHashed(unsigned nCells, unsigned nHash)
+ficlDictionary *ficlDictionaryCreateHashed(ficlSystem *system, unsigned size, unsigned bucketCount)
{
- FICL_DICT *pDict;
+ ficlDictionary *dictionary;
size_t nAlloc;
- nAlloc = sizeof (FICL_HASH) + nCells * sizeof (CELL)
- + (nHash - 1) * sizeof (FICL_WORD *);
+ nAlloc = sizeof(ficlDictionary) + (size * sizeof (ficlCell))
+ + sizeof(ficlHash) + (bucketCount - 1) * sizeof (ficlWord *);
+
+ dictionary = ficlMalloc(nAlloc);
+ FICL_SYSTEM_ASSERT(system, dictionary != NULL);
+
+ dictionary->size = size;
+ dictionary->system = system;
- pDict = ficlMalloc(sizeof (FICL_DICT));
- assert(pDict);
- memset(pDict, 0, sizeof (FICL_DICT));
- pDict->dict = ficlMalloc(nAlloc);
- assert(pDict->dict);
-
- pDict->size = nCells;
- dictEmpty(pDict, nHash);
- return pDict;
+ ficlDictionaryEmpty(dictionary, bucketCount);
+ return dictionary;
}
@@ -407,18 +469,18 @@
d i c t C r e a t e W o r d l i s t
** Create and initialize an anonymous wordlist
**************************************************************************/
-FICL_HASH *dictCreateWordlist(FICL_DICT *dp, int nBuckets)
+ficlHash *ficlDictionaryCreateWordlist(ficlDictionary *dictionary, int bucketCount)
{
- FICL_HASH *pHash;
+ ficlHash *hash;
- dictAlign(dp);
- pHash = (FICL_HASH *)dp->here;
- dictAllot(dp, sizeof (FICL_HASH)
- + (nBuckets-1) * sizeof (FICL_WORD *));
-
- pHash->size = nBuckets;
- hashReset(pHash);
- return pHash;
+ ficlDictionaryAlign(dictionary);
+ hash = (ficlHash *)dictionary->here;
+ ficlDictionaryAllot(dictionary, sizeof (ficlHash)
+ + (bucketCount - 1) * sizeof (ficlWord *));
+
+ hash->size = bucketCount;
+ ficlHashReset(hash);
+ return hash;
}
@@ -426,10 +488,10 @@
d i c t D e l e t e
** Free all memory allocated for the given dictionary
**************************************************************************/
-void dictDelete(FICL_DICT *pDict)
+void ficlDictionaryDestroy(ficlDictionary *dictionary)
{
- assert(pDict);
- ficlFree(pDict);
+ FICL_DICTIONARY_ASSERT(dictionary, dictionary != NULL);
+ ficlFree(dictionary);
return;
}
@@ -439,194 +501,279 @@
** Empty the dictionary, reset its hash table, and reset its search order.
** Clears and (re-)creates the hash table with the size specified by nHash.
**************************************************************************/
-void dictEmpty(FICL_DICT *pDict, unsigned nHash)
+void ficlDictionaryEmpty(ficlDictionary *dictionary, unsigned bucketCount)
{
- FICL_HASH *pHash;
+ ficlHash *hash;
- pDict->here = pDict->dict;
+ dictionary->here = dictionary->base;
- dictAlign(pDict);
- pHash = (FICL_HASH *)pDict->here;
- dictAllot(pDict,
- sizeof (FICL_HASH) + (nHash - 1) * sizeof (FICL_WORD *));
+ ficlDictionaryAlign(dictionary);
+ hash = (ficlHash *)dictionary->here;
+ ficlDictionaryAllot(dictionary,
+ sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *));
- pHash->size = nHash;
- hashReset(pHash);
+ hash->size = bucketCount;
+ ficlHashReset(hash);
- pDict->pForthWords = pHash;
- pDict->smudge = NULL;
- dictResetSearchOrder(pDict);
+ dictionary->forthWordlist = hash;
+ dictionary->smudge = NULL;
+ ficlDictionaryResetSearchOrder(dictionary);
return;
}
/**************************************************************************
- d i c t H a s h S u m m a r y
-** Calculate a figure of merit for the dictionary hash table based
-** on the average search depth for all the words in the dictionary,
-** assuming uniform distribution of target keys. The figure of merit
-** is the ratio of the total search depth for all keys in the table
-** versus a theoretical optimum that would be achieved if the keys
-** were distributed into the table as evenly as possible.
-** The figure would be worse if the hash table used an open
-** addressing scheme (i.e. collisions resolved by searching the
-** table for an empty slot) for a given size table.
+** i s A F i c l W o r d
+** Vet a candidate pointer carefully to make sure
+** it's not some chunk o' inline data...
+** It has to have a name, and it has to look
+** like it's in the dictionary address range.
+** NOTE: this excludes :noname words!
**************************************************************************/
-#if FICL_WANT_FLOAT
-void dictHashSummary(FICL_VM *pVM)
+int ficlDictionaryIsAWord(ficlDictionary *dictionary, ficlWord *word)
{
- FICL_DICT *dp = vmGetDict(pVM);
- FICL_HASH *pFHash;
- FICL_WORD **pHash;
- unsigned size;
- FICL_WORD *pFW;
- unsigned i;
- int nMax = 0;
- int nWords = 0;
- int nFilled;
- double avg = 0.0;
- double best;
- int nAvg, nRem, nDepth;
-
- dictCheck(dp, pVM, 0);
-
- pFHash = dp->pSearch[dp->nLists - 1];
- pHash = pFHash->table;
- size = pFHash->size;
- nFilled = size;
+ if ( (((ficlInstruction)word) > ficlInstructionInvalid)
+ && (((ficlInstruction)word) < ficlInstructionLast) )
+ return 1;
- for (i = 0; i < size; i++)
- {
- int n = 0;
- pFW = pHash[i];
+ if (!ficlDictionaryIncludes(dictionary, word))
+ return 0;
- while (pFW)
- {
- ++n;
- ++nWords;
- pFW = pFW->link;
- }
+ if (!ficlDictionaryIncludes(dictionary, word->name))
+ return 0;
- avg += (double)(n * (n+1)) / 2.0;
+ if ((word->link != NULL) && !ficlDictionaryIncludes(dictionary, word->link))
+ return 0;
- if (n > nMax)
- nMax = n;
- if (n == 0)
- --nFilled;
- }
+ if ((word->length <= 0) || (word->name[word->length] != '\0'))
+ return 0;
- /* Calc actual avg search depth for this hash */
- avg = avg / nWords;
+ if (strlen(word->name) != word->length)
+ return 0;
- /* Calc best possible performance with this size hash */
- nAvg = nWords / size;
- nRem = nWords % size;
- nDepth = size * (nAvg * (nAvg+1))/2 + (nAvg+1)*nRem;
- best = (double)nDepth/nWords;
+ return 1;
+}
- sprintf(pVM->pad,
- "%d bins, %2.0f%% filled, Depth: Max=%d, Avg=%2.1f, Best=%2.1f, Score: %2.0f%%",
- size,
- (double)nFilled * 100.0 / size, nMax,
- avg,
- best,
- 100.0 * best / avg);
- ficlTextOut(pVM, pVM->pad, 1);
+/**************************************************************************
+ f i n d E n c l o s i n g W o r d
+** Given a pointer to something, check to make sure it's an address in the
+** dictionary. If so, search backwards until we find something that looks
+** like a dictionary header. If successful, return the address of the
+** ficlWord found. Otherwise return NULL.
+** nSEARCH_CELLS sets the maximum neighborhood this func will search before giving up
+**************************************************************************/
+#define nSEARCH_CELLS 100
- return;
+ficlWord *ficlDictionaryFindEnclosingWord(ficlDictionary *dictionary, ficlCell *cell)
+{
+ ficlWord *word;
+ int i;
+
+ if (!ficlDictionaryIncludes(dictionary, (void *)cell))
+ return NULL;
+
+ for (i = nSEARCH_CELLS; i > 0; --i, --cell)
+ {
+ word = (ficlWord *)(cell + 1 - (sizeof(ficlWord) / sizeof(ficlCell)));
+ if (ficlDictionaryIsAWord(dictionary, word))
+ return word;
+ }
+
+ return NULL;
}
-#endif
+
/**************************************************************************
d i c t I n c l u d e s
-** Returns TRUE iff the given pointer is within the address range of
+** Returns FICL_TRUE iff the given pointer is within the address range of
** the dictionary.
**************************************************************************/
-int dictIncludes(FICL_DICT *pDict, void *p)
+int ficlDictionaryIncludes(ficlDictionary *dictionary, void *p)
{
- return ((p >= (void *) &pDict->dict)
- && (p < (void *)(&pDict->dict + pDict->size))
- );
+ return ((p >= (void *) &dictionary->base)
+ && (p < (void *)(&dictionary->base + dictionary->size)));
}
+
/**************************************************************************
d i c t L o o k u p
-** Find the FICL_WORD that matches the given name and length.
+** Find the ficlWord that matches the given name and length.
** If found, returns the word's address. Otherwise returns NULL.
** Uses the search order list to search multiple wordlists.
**************************************************************************/
-FICL_WORD *dictLookup(FICL_DICT *pDict, STRINGINFO si)
+ficlWord *ficlDictionaryLookup(ficlDictionary *dictionary, ficlString name)
{
- FICL_WORD *pFW = NULL;
- FICL_HASH *pHash;
+ ficlWord *word = NULL;
+ ficlHash *hash;
int i;
- UNS16 hashCode = hashHashCode(si);
+ ficlUnsigned16 hashCode = ficlHashCode(name);
- assert(pDict);
+ FICL_DICTIONARY_ASSERT(dictionary, dictionary != NULL);
- ficlLockDictionary(1);
+ ficlDictionaryLock(dictionary, FICL_TRUE);
- for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
+ for (i = (int)dictionary->wordlistCount - 1; (i >= 0) && (!word); --i)
{
- pHash = pDict->pSearch[i];
- pFW = hashLookup(pHash, si, hashCode);
+ hash = dictionary->wordlists[i];
+ word = ficlHashLookup(hash, name, hashCode);
}
- ficlLockDictionary(0);
- return pFW;
+ ficlDictionaryLock(dictionary, FICL_TRUE);
+ return word;
}
/**************************************************************************
- 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...
+ s e e
+** TOOLS ( "<spaces>name" -- )
+** Display a human-readable representation of the named word's definition.
+** The source of the representation (object-code decompilation, source
+** block, etc.) and the particular form of the display is implementation
+** defined.
**************************************************************************/
-#if FICL_WANT_LOCALS
-FICL_WORD *ficlLookupLoc(FICL_SYSTEM *pSys, STRINGINFO si)
+/*
+** ficlSeeColon (for proctologists only)
+** Walks a colon definition, decompiling
+** on the fly. Knows about primitive control structures.
+*/
+char *ficlDictionaryInstructionNames[] =
{
- FICL_WORD *pFW = NULL;
- FICL_DICT *pDict = pSys->dp;
- FICL_HASH *pHash = ficlGetLoc(pSys)->pForthWords;
- int i;
- UNS16 hashCode = hashHashCode(si);
-
- assert(pHash);
- assert(pDict);
+#define FICL_TOKEN(token, description) description,
+#define FICL_INSTRUCTION_TOKEN(token, description, flags) description,
+#include "ficltokens.h"
+#undef FICL_TOKEN
+#undef FICL_INSTRUCTION_TOKEN
+};
- ficlLockDictionary(1);
- /*
- ** check the locals dict first...
- */
- pFW = hashLookup(pHash, si, hashCode);
+void ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word, ficlCallback *callback)
+{
+ char *trace;
+ ficlCell *cell = word->param;
+ ficlCell *param0 = cell;
+ char buffer[128];
- /*
- ** If no joy, (!pFW) --------------------------v
- ** iterate over the search list in the main dict
- */
- for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
+ for (; cell->i != ficlInstructionSemiParen; cell++)
{
- pHash = pDict->pSearch[i];
- pFW = hashLookup(pHash, si, hashCode);
+ ficlWord *word = (ficlWord *)(cell->p);
+
+ trace = buffer;
+ if ((void *)cell == (void *)buffer)
+ *trace++ = '>';
+ else
+ *trace++ = ' ';
+ trace += sprintf(trace, "%3d ", cell - param0);
+
+ if (ficlDictionaryIsAWord(dictionary, word))
+ {
+ ficlWordKind kind = ficlWordClassify(word);
+ ficlCell c, c2;
+
+ switch (kind)
*** DIFF OUTPUT TRUNCATED AT 1000 LINES ***
More information about the svn-soc-all
mailing list