Date: Tue, 30 Jun 2015 21:23:01 GMT From: clord@FreeBSD.org To: svn-soc-all@FreeBSD.org Subject: socsvn commit: r287788 - in soc2015/clord/head/sys/contrib/ficl: . softcore Message-ID: <201506302123.t5ULN1uM019783@socsvn.freebsd.org>
next in thread | raw e-mail | index | archive | help
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@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 ***
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?201506302123.t5ULN1uM019783>