xref: /illumos-gate/usr/src/common/ficl/dictionary.c (revision c0bb4f73)
1afc2ba1dSToomas Soome /*
2afc2ba1dSToomas Soome  * d i c t . c
3afc2ba1dSToomas Soome  * Forth Inspired Command Language - dictionary methods
4afc2ba1dSToomas Soome  * Author: John Sadler (john_sadler@alum.mit.edu)
5afc2ba1dSToomas Soome  * Created: 19 July 1997
6afc2ba1dSToomas Soome  * $Id: dictionary.c,v 1.2 2010/09/12 15:14:52 asau Exp $
7afc2ba1dSToomas Soome  */
8afc2ba1dSToomas Soome /*
9afc2ba1dSToomas Soome  * This file implements the dictionary -- Ficl's model of
10afc2ba1dSToomas Soome  * memory management. All Ficl words are stored in the
11afc2ba1dSToomas Soome  * dictionary. A word is a named chunk of data with its
12afc2ba1dSToomas Soome  * associated code. Ficl treats all words the same, even
13afc2ba1dSToomas Soome  * precompiled ones, so your words become first-class
14afc2ba1dSToomas Soome  * extensions of the language. You can even define new
15afc2ba1dSToomas Soome  * control structures.
16afc2ba1dSToomas Soome  *
17afc2ba1dSToomas Soome  * 29 jun 1998 (sadler) added variable sized hash table support
18afc2ba1dSToomas Soome  */
19afc2ba1dSToomas Soome /*
20afc2ba1dSToomas Soome  * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
21afc2ba1dSToomas Soome  * All rights reserved.
22afc2ba1dSToomas Soome  *
23afc2ba1dSToomas Soome  * Get the latest Ficl release at http://ficl.sourceforge.net
24afc2ba1dSToomas Soome  *
25afc2ba1dSToomas Soome  * I am interested in hearing from anyone who uses Ficl. If you have
26afc2ba1dSToomas Soome  * a problem, a success story, a defect, an enhancement request, or
27afc2ba1dSToomas Soome  * if you would like to contribute to the Ficl release, please
28afc2ba1dSToomas Soome  * contact me by email at the address above.
29afc2ba1dSToomas Soome  *
30afc2ba1dSToomas Soome  * L I C E N S E  and  D I S C L A I M E R
31afc2ba1dSToomas Soome  *
32afc2ba1dSToomas Soome  * Redistribution and use in source and binary forms, with or without
33afc2ba1dSToomas Soome  * modification, are permitted provided that the following conditions
34afc2ba1dSToomas Soome  * are met:
35afc2ba1dSToomas Soome  * 1. Redistributions of source code must retain the above copyright
36afc2ba1dSToomas Soome  *    notice, this list of conditions and the following disclaimer.
37afc2ba1dSToomas Soome  * 2. Redistributions in binary form must reproduce the above copyright
38afc2ba1dSToomas Soome  *    notice, this list of conditions and the following disclaimer in the
39afc2ba1dSToomas Soome  *    documentation and/or other materials provided with the distribution.
40afc2ba1dSToomas Soome  *
41afc2ba1dSToomas Soome  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
42afc2ba1dSToomas Soome  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
43afc2ba1dSToomas Soome  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
44afc2ba1dSToomas Soome  * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
45afc2ba1dSToomas Soome  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
46afc2ba1dSToomas Soome  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
47afc2ba1dSToomas Soome  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
48afc2ba1dSToomas Soome  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
49afc2ba1dSToomas Soome  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
50afc2ba1dSToomas Soome  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
51afc2ba1dSToomas Soome  * SUCH DAMAGE.
52afc2ba1dSToomas Soome  */
53afc2ba1dSToomas Soome 
54afc2ba1dSToomas Soome #include "ficl.h"
55afc2ba1dSToomas Soome 
56afc2ba1dSToomas Soome #define	FICL_SAFE_CALLBACK_FROM_SYSTEM(system)		\
57afc2ba1dSToomas Soome 	(((system) != NULL) ? &((system)->callback) : NULL)
58afc2ba1dSToomas Soome #define	FICL_SAFE_SYSTEM_FROM_DICTIONARY(dictionary)	\
59afc2ba1dSToomas Soome 	(((dictionary) != NULL) ? (dictionary)->system : NULL)
60afc2ba1dSToomas Soome #define	FICL_DICTIONARY_ASSERT(dictionary, expression)	\
61afc2ba1dSToomas Soome 	FICL_SYSTEM_ASSERT(FICL_SAFE_SYSTEM_FROM_DICTIONARY(dictionary), \
62afc2ba1dSToomas Soome 	expression)
63afc2ba1dSToomas Soome 
64afc2ba1dSToomas Soome /*
65afc2ba1dSToomas Soome  * d i c t A b o r t D e f i n i t i o n
66afc2ba1dSToomas Soome  * Abort a definition in process: reclaim its memory and unlink it
67afc2ba1dSToomas Soome  * from the dictionary list. Assumes that there is a smudged
68afc2ba1dSToomas Soome  * definition in process...otherwise does nothing.
69afc2ba1dSToomas Soome  * NOTE: this function is not smart enough to unlink a word that
70afc2ba1dSToomas Soome  * has been successfully defined (ie linked into a hash). It
71afc2ba1dSToomas Soome  * only works for defs in process. If the def has been unsmudged,
72afc2ba1dSToomas Soome  * nothing happens.
73afc2ba1dSToomas Soome  */
74afc2ba1dSToomas Soome void
ficlDictionaryAbortDefinition(ficlDictionary * dictionary)75afc2ba1dSToomas Soome ficlDictionaryAbortDefinition(ficlDictionary *dictionary)
76afc2ba1dSToomas Soome {
77afc2ba1dSToomas Soome 	ficlWord *word;
78afc2ba1dSToomas Soome 	ficlDictionaryLock(dictionary, FICL_TRUE);
79afc2ba1dSToomas Soome 	word = dictionary->smudge;
80afc2ba1dSToomas Soome 
81afc2ba1dSToomas Soome 	if (word->flags & FICL_WORD_SMUDGED)
82afc2ba1dSToomas Soome 		dictionary->here = (ficlCell *)word->name;
83afc2ba1dSToomas Soome 
84afc2ba1dSToomas Soome 	ficlDictionaryLock(dictionary, FICL_FALSE);
85afc2ba1dSToomas Soome }
86afc2ba1dSToomas Soome 
87afc2ba1dSToomas Soome /*
88afc2ba1dSToomas Soome  * d i c t A l i g n
89afc2ba1dSToomas Soome  * Align the dictionary's free space pointer
90afc2ba1dSToomas Soome  */
91afc2ba1dSToomas Soome void
ficlDictionaryAlign(ficlDictionary * dictionary)92afc2ba1dSToomas Soome ficlDictionaryAlign(ficlDictionary *dictionary)
93afc2ba1dSToomas Soome {
94afc2ba1dSToomas Soome 	dictionary->here = ficlAlignPointer(dictionary->here);
95afc2ba1dSToomas Soome }
96afc2ba1dSToomas Soome 
97afc2ba1dSToomas Soome /*
98afc2ba1dSToomas Soome  * d i c t A l l o t
99afc2ba1dSToomas Soome  * Allocate or remove n chars of dictionary space, with
100afc2ba1dSToomas Soome  * checks for underrun and overrun
101afc2ba1dSToomas Soome  */
102afc2ba1dSToomas Soome void
ficlDictionaryAllot(ficlDictionary * dictionary,int n)103afc2ba1dSToomas Soome ficlDictionaryAllot(ficlDictionary *dictionary, int n)
104afc2ba1dSToomas Soome {
105afc2ba1dSToomas Soome 	char *here = (char *)dictionary->here;
106afc2ba1dSToomas Soome 	here += n;
107afc2ba1dSToomas Soome 	dictionary->here = FICL_POINTER_TO_CELL(here);
108afc2ba1dSToomas Soome }
109afc2ba1dSToomas Soome 
110afc2ba1dSToomas Soome /*
111afc2ba1dSToomas Soome  * d i c t A l l o t C e l l s
112afc2ba1dSToomas Soome  * Reserve space for the requested number of ficlCells in the
113afc2ba1dSToomas Soome  * dictionary. If nficlCells < 0 , removes space from the dictionary.
114afc2ba1dSToomas Soome  */
115afc2ba1dSToomas Soome void
ficlDictionaryAllotCells(ficlDictionary * dictionary,int nficlCells)116afc2ba1dSToomas Soome ficlDictionaryAllotCells(ficlDictionary *dictionary, int nficlCells)
117afc2ba1dSToomas Soome {
118afc2ba1dSToomas Soome 	dictionary->here += nficlCells;
119afc2ba1dSToomas Soome }
120afc2ba1dSToomas Soome 
121afc2ba1dSToomas Soome /*
122afc2ba1dSToomas Soome  * d i c t A p p e n d C e l l
123afc2ba1dSToomas Soome  * Append the specified ficlCell to the dictionary
124afc2ba1dSToomas Soome  */
125afc2ba1dSToomas Soome void
ficlDictionaryAppendCell(ficlDictionary * dictionary,ficlCell c)126afc2ba1dSToomas Soome ficlDictionaryAppendCell(ficlDictionary *dictionary, ficlCell c)
127afc2ba1dSToomas Soome {
128afc2ba1dSToomas Soome 	*dictionary->here++ = c;
129afc2ba1dSToomas Soome }
130afc2ba1dSToomas Soome 
131afc2ba1dSToomas Soome /*
132afc2ba1dSToomas Soome  * d i c t A p p e n d C h a r
133afc2ba1dSToomas Soome  * Append the specified char to the dictionary
134afc2ba1dSToomas Soome  */
135afc2ba1dSToomas Soome void
ficlDictionaryAppendCharacter(ficlDictionary * dictionary,char c)136afc2ba1dSToomas Soome ficlDictionaryAppendCharacter(ficlDictionary *dictionary, char c)
137afc2ba1dSToomas Soome {
138afc2ba1dSToomas Soome 	char *here = (char *)dictionary->here;
139afc2ba1dSToomas Soome 	*here++ = c;
140afc2ba1dSToomas Soome 	dictionary->here = FICL_POINTER_TO_CELL(here);
141afc2ba1dSToomas Soome }
142afc2ba1dSToomas Soome 
143afc2ba1dSToomas Soome /*
144afc2ba1dSToomas Soome  * d i c t A p p e n d U N S
145afc2ba1dSToomas Soome  * Append the specified ficlUnsigned to the dictionary
146afc2ba1dSToomas Soome  */
147afc2ba1dSToomas Soome void
ficlDictionaryAppendUnsigned(ficlDictionary * dictionary,ficlUnsigned u)148afc2ba1dSToomas Soome ficlDictionaryAppendUnsigned(ficlDictionary *dictionary, ficlUnsigned u)
149afc2ba1dSToomas Soome {
150afc2ba1dSToomas Soome 	ficlCell c;
151afc2ba1dSToomas Soome 
152afc2ba1dSToomas Soome 	c.u = u;
153afc2ba1dSToomas Soome 	ficlDictionaryAppendCell(dictionary, c);
154afc2ba1dSToomas Soome }
155afc2ba1dSToomas Soome 
156afc2ba1dSToomas Soome void *
ficlDictionaryAppendData(ficlDictionary * dictionary,void * data,ficlInteger length)157afc2ba1dSToomas Soome ficlDictionaryAppendData(ficlDictionary *dictionary, void *data,
158afc2ba1dSToomas Soome     ficlInteger length)
159afc2ba1dSToomas Soome {
160afc2ba1dSToomas Soome 	char *here = (char *)dictionary->here;
161afc2ba1dSToomas Soome 	char *oldHere = here;
162afc2ba1dSToomas Soome 	char *from = (char *)data;
163afc2ba1dSToomas Soome 
164afc2ba1dSToomas Soome 	if (length == 0) {
165afc2ba1dSToomas Soome 		ficlDictionaryAlign(dictionary);
166afc2ba1dSToomas Soome 		return ((char *)dictionary->here);
167afc2ba1dSToomas Soome 	}
168afc2ba1dSToomas Soome 
169afc2ba1dSToomas Soome 	while (length) {
170afc2ba1dSToomas Soome 		*here++ = *from++;
171afc2ba1dSToomas Soome 		length--;
172afc2ba1dSToomas Soome 	}
173afc2ba1dSToomas Soome 
174afc2ba1dSToomas Soome 	*here++ = '\0';
175afc2ba1dSToomas Soome 
176afc2ba1dSToomas Soome 	dictionary->here = FICL_POINTER_TO_CELL(here);
177afc2ba1dSToomas Soome 	ficlDictionaryAlign(dictionary);
178afc2ba1dSToomas Soome 	return (oldHere);
179afc2ba1dSToomas Soome }
180afc2ba1dSToomas Soome 
181afc2ba1dSToomas Soome /*
182afc2ba1dSToomas Soome  * d i c t C o p y N a m e
183afc2ba1dSToomas Soome  * Copy up to FICL_NAME_LENGTH characters of the name specified by s into
184afc2ba1dSToomas Soome  * the dictionary starting at "here", then NULL-terminate the name,
185afc2ba1dSToomas Soome  * point "here" to the next available byte, and return the address of
186afc2ba1dSToomas Soome  * the beginning of the name. Used by dictAppendWord.
187afc2ba1dSToomas Soome  * N O T E S :
188afc2ba1dSToomas Soome  * 1. "here" is guaranteed to be aligned after this operation.
189afc2ba1dSToomas Soome  * 2. If the string has zero length, align and return "here"
190afc2ba1dSToomas Soome  */
191afc2ba1dSToomas Soome char *
ficlDictionaryAppendString(ficlDictionary * dictionary,ficlString s)192afc2ba1dSToomas Soome ficlDictionaryAppendString(ficlDictionary *dictionary, ficlString s)
193afc2ba1dSToomas Soome {
194afc2ba1dSToomas Soome 	void *data = FICL_STRING_GET_POINTER(s);
195afc2ba1dSToomas Soome 	ficlInteger length = FICL_STRING_GET_LENGTH(s);
196afc2ba1dSToomas Soome 
197afc2ba1dSToomas Soome 	if (length > FICL_NAME_LENGTH)
198afc2ba1dSToomas Soome 		length = FICL_NAME_LENGTH;
199afc2ba1dSToomas Soome 
200afc2ba1dSToomas Soome 	return (ficlDictionaryAppendData(dictionary, data, length));
201afc2ba1dSToomas Soome }
202afc2ba1dSToomas Soome 
203afc2ba1dSToomas Soome ficlWord *
ficlDictionaryAppendConstantInstruction(ficlDictionary * dictionary,ficlString name,ficlInstruction instruction,ficlInteger value)204afc2ba1dSToomas Soome ficlDictionaryAppendConstantInstruction(ficlDictionary *dictionary,
205afc2ba1dSToomas Soome     ficlString name, ficlInstruction instruction, ficlInteger value)
206afc2ba1dSToomas Soome {
207afc2ba1dSToomas Soome 	ficlWord *word = ficlDictionaryAppendWord(dictionary, name,
208afc2ba1dSToomas Soome 	    (ficlPrimitive)instruction, FICL_WORD_DEFAULT);
209afc2ba1dSToomas Soome 
210afc2ba1dSToomas Soome 	if (word != NULL)
211afc2ba1dSToomas Soome 		ficlDictionaryAppendUnsigned(dictionary, value);
212afc2ba1dSToomas Soome 	return (word);
213afc2ba1dSToomas Soome }
214afc2ba1dSToomas Soome 
215afc2ba1dSToomas Soome ficlWord *
ficlDictionaryAppend2ConstantInstruction(ficlDictionary * dictionary,ficlString name,ficlInstruction instruction,ficl2Integer value)216afc2ba1dSToomas Soome ficlDictionaryAppend2ConstantInstruction(ficlDictionary *dictionary,
217afc2ba1dSToomas Soome     ficlString name, ficlInstruction instruction, ficl2Integer value)
218afc2ba1dSToomas Soome {
219afc2ba1dSToomas Soome 	ficlWord *word = ficlDictionaryAppendWord(dictionary, name,
220afc2ba1dSToomas Soome 	    (ficlPrimitive)instruction, FICL_WORD_DEFAULT);
221afc2ba1dSToomas Soome 
222afc2ba1dSToomas Soome 	if (word != NULL) {
223afc2ba1dSToomas Soome 		ficlDictionaryAppendUnsigned(dictionary,
224afc2ba1dSToomas Soome 		    FICL_2UNSIGNED_GET_HIGH(value));
225afc2ba1dSToomas Soome 		ficlDictionaryAppendUnsigned(dictionary,
226afc2ba1dSToomas Soome 		    FICL_2UNSIGNED_GET_LOW(value));
227afc2ba1dSToomas Soome 	}
228afc2ba1dSToomas Soome 	return (word);
229afc2ba1dSToomas Soome }
230afc2ba1dSToomas Soome 
231afc2ba1dSToomas Soome ficlWord *
ficlDictionaryAppendConstant(ficlDictionary * dictionary,char * name,ficlInteger value)232afc2ba1dSToomas Soome ficlDictionaryAppendConstant(ficlDictionary *dictionary, char *name,
233afc2ba1dSToomas Soome     ficlInteger value)
234afc2ba1dSToomas Soome {
235afc2ba1dSToomas Soome 	ficlString s;
236afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
237afc2ba1dSToomas Soome 	return (ficlDictionaryAppendConstantInstruction(dictionary, s,
238afc2ba1dSToomas Soome 	    ficlInstructionConstantParen, value));
239afc2ba1dSToomas Soome }
240afc2ba1dSToomas Soome 
241afc2ba1dSToomas Soome ficlWord *
ficlDictionaryAppend2Constant(ficlDictionary * dictionary,char * name,ficl2Integer value)242afc2ba1dSToomas Soome ficlDictionaryAppend2Constant(ficlDictionary *dictionary, char *name,
243afc2ba1dSToomas Soome     ficl2Integer value)
244afc2ba1dSToomas Soome {
245afc2ba1dSToomas Soome 	ficlString s;
246afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
247afc2ba1dSToomas Soome 	return (ficlDictionaryAppend2ConstantInstruction(dictionary, s,
248afc2ba1dSToomas Soome 	    ficlInstruction2ConstantParen, value));
249afc2ba1dSToomas Soome }
250afc2ba1dSToomas Soome 
251afc2ba1dSToomas Soome ficlWord *
ficlDictionarySetConstantInstruction(ficlDictionary * dictionary,ficlString name,ficlInstruction instruction,ficlInteger value)252afc2ba1dSToomas Soome ficlDictionarySetConstantInstruction(ficlDictionary *dictionary,
253afc2ba1dSToomas Soome     ficlString name, ficlInstruction instruction, ficlInteger value)
254afc2ba1dSToomas Soome {
255afc2ba1dSToomas Soome 	ficlWord *word = ficlDictionaryLookup(dictionary, name);
256afc2ba1dSToomas Soome 	ficlCell c;
257afc2ba1dSToomas Soome 
258afc2ba1dSToomas Soome 	if (word == NULL) {
259afc2ba1dSToomas Soome 		word = ficlDictionaryAppendConstantInstruction(dictionary,
260afc2ba1dSToomas Soome 		    name, instruction, value);
261afc2ba1dSToomas Soome 	} else {
262afc2ba1dSToomas Soome 		word->code = (ficlPrimitive)instruction;
263afc2ba1dSToomas Soome 		c.i = value;
264afc2ba1dSToomas Soome 		word->param[0] = c;
265afc2ba1dSToomas Soome 	}
266afc2ba1dSToomas Soome 	return (word);
267afc2ba1dSToomas Soome }
268afc2ba1dSToomas Soome 
269afc2ba1dSToomas Soome ficlWord *
ficlDictionarySetConstant(ficlDictionary * dictionary,char * name,ficlInteger value)270afc2ba1dSToomas Soome ficlDictionarySetConstant(ficlDictionary *dictionary, char *name,
271afc2ba1dSToomas Soome     ficlInteger value)
272afc2ba1dSToomas Soome {
273afc2ba1dSToomas Soome 	ficlString s;
274afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
275afc2ba1dSToomas Soome 	return (ficlDictionarySetConstantInstruction(dictionary, s,
276afc2ba1dSToomas Soome 	    ficlInstructionConstantParen, value));
277afc2ba1dSToomas Soome }
278afc2ba1dSToomas Soome 
279afc2ba1dSToomas Soome ficlWord *
ficlDictionarySet2ConstantInstruction(ficlDictionary * dictionary,ficlString s,ficlInstruction instruction,ficl2Integer value)280afc2ba1dSToomas Soome ficlDictionarySet2ConstantInstruction(ficlDictionary *dictionary, ficlString s,
281afc2ba1dSToomas Soome     ficlInstruction instruction, ficl2Integer value)
282afc2ba1dSToomas Soome {
283afc2ba1dSToomas Soome 	ficlWord *word;
284afc2ba1dSToomas Soome 	word = ficlDictionaryLookup(dictionary, s);
285afc2ba1dSToomas Soome 
286afc2ba1dSToomas Soome 	/*
287afc2ba1dSToomas Soome 	 * only reuse the existing word if we're sure it has space for a
288afc2ba1dSToomas Soome 	 * 2constant
289afc2ba1dSToomas Soome 	 */
290afc2ba1dSToomas Soome #if FICL_WANT_FLOAT
291afc2ba1dSToomas Soome 	if ((word != NULL) &&
292afc2ba1dSToomas Soome 	    ((((ficlInstruction)word->code) == ficlInstruction2ConstantParen) ||
293afc2ba1dSToomas Soome 	    (((ficlInstruction)word->code) == ficlInstructionF2ConstantParen)))
294afc2ba1dSToomas Soome #else
295afc2ba1dSToomas Soome 	if ((word != NULL) &&
296afc2ba1dSToomas Soome 	    ((((ficlInstruction)word->code) == ficlInstruction2ConstantParen)))
297afc2ba1dSToomas Soome #endif /* FICL_WANT_FLOAT */
298afc2ba1dSToomas Soome 	{
299afc2ba1dSToomas Soome 		word->code = (ficlPrimitive)instruction;
300afc2ba1dSToomas Soome 		word->param[0].u = FICL_2UNSIGNED_GET_HIGH(value);
301afc2ba1dSToomas Soome 		word->param[1].u = FICL_2UNSIGNED_GET_LOW(value);
302afc2ba1dSToomas Soome 	} else {
303afc2ba1dSToomas Soome 		word = ficlDictionaryAppend2ConstantInstruction(dictionary, s,
304afc2ba1dSToomas Soome 		    instruction, value);
305afc2ba1dSToomas Soome 	}
306afc2ba1dSToomas Soome 
307afc2ba1dSToomas Soome 	return (word);
308afc2ba1dSToomas Soome }
309afc2ba1dSToomas Soome 
310afc2ba1dSToomas Soome ficlWord *
ficlDictionarySet2Constant(ficlDictionary * dictionary,char * name,ficl2Integer value)311afc2ba1dSToomas Soome ficlDictionarySet2Constant(ficlDictionary *dictionary, char *name,
312afc2ba1dSToomas Soome     ficl2Integer value)
313afc2ba1dSToomas Soome {
314afc2ba1dSToomas Soome 	ficlString s;
315afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
316afc2ba1dSToomas Soome 
317afc2ba1dSToomas Soome 	return (ficlDictionarySet2ConstantInstruction(dictionary, s,
318afc2ba1dSToomas Soome 	    ficlInstruction2ConstantParen, value));
319afc2ba1dSToomas Soome }
320afc2ba1dSToomas Soome 
321afc2ba1dSToomas Soome ficlWord *
ficlDictionarySetConstantString(ficlDictionary * dictionary,char * name,char * value)322afc2ba1dSToomas Soome ficlDictionarySetConstantString(ficlDictionary *dictionary, char *name,
323afc2ba1dSToomas Soome     char *value)
324afc2ba1dSToomas Soome {
325afc2ba1dSToomas Soome 	ficlString s;
326afc2ba1dSToomas Soome 	ficl2Integer valueAs2Integer;
327afc2ba1dSToomas Soome 	FICL_2INTEGER_SET(strlen(value), (intptr_t)value, valueAs2Integer);
328afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
329afc2ba1dSToomas Soome 
330afc2ba1dSToomas Soome 	return (ficlDictionarySet2ConstantInstruction(dictionary, s,
331afc2ba1dSToomas Soome 	    ficlInstruction2ConstantParen, valueAs2Integer));
332afc2ba1dSToomas Soome }
333afc2ba1dSToomas Soome 
334afc2ba1dSToomas Soome /*
335afc2ba1dSToomas Soome  * d i c t A p p e n d W o r d
336afc2ba1dSToomas Soome  * Create a new word in the dictionary with the specified
337afc2ba1dSToomas Soome  * ficlString, code, and flags. Does not require a NULL-terminated
338afc2ba1dSToomas Soome  * name.
339afc2ba1dSToomas Soome  */
340afc2ba1dSToomas Soome ficlWord *
ficlDictionaryAppendWord(ficlDictionary * dictionary,ficlString name,ficlPrimitive code,ficlUnsigned8 flags)341afc2ba1dSToomas Soome ficlDictionaryAppendWord(ficlDictionary *dictionary, ficlString name,
342afc2ba1dSToomas Soome     ficlPrimitive code, ficlUnsigned8 flags)
343afc2ba1dSToomas Soome {
344afc2ba1dSToomas Soome 	ficlUnsigned8 length = (ficlUnsigned8)FICL_STRING_GET_LENGTH(name);
345afc2ba1dSToomas Soome 	char *nameCopy;
346afc2ba1dSToomas Soome 	ficlWord *word;
347afc2ba1dSToomas Soome 
348afc2ba1dSToomas Soome 	ficlDictionaryLock(dictionary, FICL_TRUE);
349afc2ba1dSToomas Soome 
350afc2ba1dSToomas Soome 	/*
351afc2ba1dSToomas Soome 	 * NOTE: ficlDictionaryAppendString advances "here" as a side-effect.
352afc2ba1dSToomas Soome 	 * It must execute before word is initialized.
353afc2ba1dSToomas Soome 	 */
354afc2ba1dSToomas Soome 	nameCopy = ficlDictionaryAppendString(dictionary, name);
355afc2ba1dSToomas Soome 	word = (ficlWord *)dictionary->here;
356afc2ba1dSToomas Soome 	dictionary->smudge = word;
357afc2ba1dSToomas Soome 	word->hash = ficlHashCode(name);
358afc2ba1dSToomas Soome 	word->code = code;
359afc2ba1dSToomas Soome 	word->semiParen = ficlInstructionSemiParen;
360afc2ba1dSToomas Soome 	word->flags = (ficlUnsigned8)(flags | FICL_WORD_SMUDGED);
361afc2ba1dSToomas Soome 	word->length = length;
362afc2ba1dSToomas Soome 	word->name = nameCopy;
363afc2ba1dSToomas Soome 
364afc2ba1dSToomas Soome 	/*
365afc2ba1dSToomas Soome 	 * Point "here" to first ficlCell of new word's param area...
366afc2ba1dSToomas Soome 	 */
367afc2ba1dSToomas Soome 	dictionary->here = word->param;
368afc2ba1dSToomas Soome 
369afc2ba1dSToomas Soome 	if (!(flags & FICL_WORD_SMUDGED))
370afc2ba1dSToomas Soome 		ficlDictionaryUnsmudge(dictionary);
371afc2ba1dSToomas Soome 
372afc2ba1dSToomas Soome 	ficlDictionaryLock(dictionary, FICL_FALSE);
373afc2ba1dSToomas Soome 	return (word);
374afc2ba1dSToomas Soome }
375afc2ba1dSToomas Soome 
376afc2ba1dSToomas Soome /*
377afc2ba1dSToomas Soome  * d i c t A p p e n d W o r d
378afc2ba1dSToomas Soome  * Create a new word in the dictionary with the specified
379afc2ba1dSToomas Soome  * name, code, and flags. Name must be NULL-terminated.
380afc2ba1dSToomas Soome  */
381afc2ba1dSToomas Soome ficlWord *
ficlDictionaryAppendPrimitive(ficlDictionary * dictionary,char * name,ficlPrimitive code,ficlUnsigned8 flags)382afc2ba1dSToomas Soome ficlDictionaryAppendPrimitive(ficlDictionary *dictionary, char *name,
383afc2ba1dSToomas Soome     ficlPrimitive code, ficlUnsigned8 flags)
384afc2ba1dSToomas Soome {
385afc2ba1dSToomas Soome 	ficlString s;
386afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
387afc2ba1dSToomas Soome 
388afc2ba1dSToomas Soome 	return (ficlDictionaryAppendWord(dictionary, s, code, flags));
389afc2ba1dSToomas Soome }
390afc2ba1dSToomas Soome 
391afc2ba1dSToomas Soome ficlWord *
ficlDictionarySetPrimitive(ficlDictionary * dictionary,char * name,ficlPrimitive code,ficlUnsigned8 flags)392afc2ba1dSToomas Soome ficlDictionarySetPrimitive(ficlDictionary *dictionary, char *name,
393afc2ba1dSToomas Soome     ficlPrimitive code, ficlUnsigned8 flags)
394afc2ba1dSToomas Soome {
395afc2ba1dSToomas Soome 	ficlString s;
396afc2ba1dSToomas Soome 	ficlWord *word;
397afc2ba1dSToomas Soome 
398afc2ba1dSToomas Soome 	FICL_STRING_SET_FROM_CSTRING(s, name);
399afc2ba1dSToomas Soome 	word = ficlDictionaryLookup(dictionary, s);
400afc2ba1dSToomas Soome 
401afc2ba1dSToomas Soome 	if (word == NULL) {
402afc2ba1dSToomas Soome 		word = ficlDictionaryAppendPrimitive(dictionary, name,
403afc2ba1dSToomas Soome 		    code, flags);
404afc2ba1dSToomas Soome 	} else {
405afc2ba1dSToomas Soome 		word->code = (ficlPrimitive)code;
406afc2ba1dSToomas Soome 		word->flags = flags;
407afc2ba1dSToomas Soome 	}
408afc2ba1dSToomas Soome 	return (word);
409afc2ba1dSToomas Soome }
410afc2ba1dSToomas Soome 
411afc2ba1dSToomas Soome ficlWord *
ficlDictionaryAppendInstruction(ficlDictionary * dictionary,char * name,ficlInstruction i,ficlUnsigned8 flags)412afc2ba1dSToomas Soome ficlDictionaryAppendInstruction(ficlDictionary *dictionary, char *name,
413afc2ba1dSToomas Soome     ficlInstruction i, ficlUnsigned8 flags)
414afc2ba1dSToomas Soome {
415afc2ba1dSToomas Soome 	return (ficlDictionaryAppendPrimitive(dictionary, name,
416afc2ba1dSToomas Soome 	    (ficlPrimitive)i, (ficlUnsigned8)(FICL_WORD_INSTRUCTION | flags)));
417afc2ba1dSToomas Soome }
418afc2ba1dSToomas Soome 
419afc2ba1dSToomas Soome ficlWord *
ficlDictionarySetInstruction(ficlDictionary * dictionary,char * name,ficlInstruction i,ficlUnsigned8 flags)420afc2ba1dSToomas Soome ficlDictionarySetInstruction(ficlDictionary *dictionary, char *name,
421afc2ba1dSToomas Soome     ficlInstruction i, ficlUnsigned8 flags)
422afc2ba1dSToomas Soome {
423afc2ba1dSToomas Soome 	return (ficlDictionarySetPrimitive(dictionary, name,
424afc2ba1dSToomas Soome 	    (ficlPrimitive)i, (ficlUnsigned8)(FICL_WORD_INSTRUCTION | flags)));
425afc2ba1dSToomas Soome }
426afc2ba1dSToomas Soome 
427afc2ba1dSToomas Soome /*
428afc2ba1dSToomas Soome  * d i c t C e l l s A v a i l
429afc2ba1dSToomas Soome  * Returns the number of empty ficlCells left in the dictionary
430afc2ba1dSToomas Soome  */
431afc2ba1dSToomas Soome int
ficlDictionaryCellsAvailable(ficlDictionary * dictionary)432afc2ba1dSToomas Soome ficlDictionaryCellsAvailable(ficlDictionary *dictionary)
433afc2ba1dSToomas Soome {
434afc2ba1dSToomas Soome 	return (dictionary->size - ficlDictionaryCellsUsed(dictionary));
435afc2ba1dSToomas Soome }
436afc2ba1dSToomas Soome 
437afc2ba1dSToomas Soome /*
438afc2ba1dSToomas Soome  * d i c t C e l l s U s e d
439afc2ba1dSToomas Soome  * Returns the number of ficlCells consumed in the dicionary
440afc2ba1dSToomas Soome  */
441afc2ba1dSToomas Soome int
ficlDictionaryCellsUsed(ficlDictionary * dictionary)442afc2ba1dSToomas Soome ficlDictionaryCellsUsed(ficlDictionary *dictionary)
443afc2ba1dSToomas Soome {
444afc2ba1dSToomas Soome 	return (dictionary->here - dictionary->base);
445afc2ba1dSToomas Soome }
446afc2ba1dSToomas Soome 
447afc2ba1dSToomas Soome /*
448afc2ba1dSToomas Soome  * d i c t C r e a t e
449afc2ba1dSToomas Soome  * Create and initialize a dictionary with the specified number
450afc2ba1dSToomas Soome  * of ficlCells capacity, and no hashing (hash size == 1).
451afc2ba1dSToomas Soome  */
452afc2ba1dSToomas Soome ficlDictionary *
ficlDictionaryCreate(ficlSystem * system,unsigned size)453afc2ba1dSToomas Soome ficlDictionaryCreate(ficlSystem *system, unsigned size)
454afc2ba1dSToomas Soome {
455afc2ba1dSToomas Soome 	return (ficlDictionaryCreateHashed(system, size, 1));
456afc2ba1dSToomas Soome }
457afc2ba1dSToomas Soome 
458afc2ba1dSToomas Soome ficlDictionary *
ficlDictionaryCreateHashed(ficlSystem * system,unsigned size,unsigned bucketCount)459afc2ba1dSToomas Soome ficlDictionaryCreateHashed(ficlSystem *system, unsigned size,
460afc2ba1dSToomas Soome     unsigned bucketCount)
461afc2ba1dSToomas Soome {
462afc2ba1dSToomas Soome 	ficlDictionary *dictionary;
463afc2ba1dSToomas Soome 	size_t nAlloc;
464afc2ba1dSToomas Soome 
465afc2ba1dSToomas Soome 	nAlloc =  sizeof (ficlDictionary) + (size * sizeof (ficlCell))
466afc2ba1dSToomas Soome 	    + sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *);
467afc2ba1dSToomas Soome 
468afc2ba1dSToomas Soome 	dictionary = ficlMalloc(nAlloc);
469afc2ba1dSToomas Soome 	FICL_SYSTEM_ASSERT(system, dictionary != NULL);
470afc2ba1dSToomas Soome 
471afc2ba1dSToomas Soome 	dictionary->size = size;
472afc2ba1dSToomas Soome 	dictionary->system = system;
473afc2ba1dSToomas Soome 
474afc2ba1dSToomas Soome 	ficlDictionaryEmpty(dictionary, bucketCount);
475afc2ba1dSToomas Soome 	return (dictionary);
476afc2ba1dSToomas Soome }
477afc2ba1dSToomas Soome 
478afc2ba1dSToomas Soome /*
479afc2ba1dSToomas Soome  * d i c t C r e a t e W o r d l i s t
480afc2ba1dSToomas Soome  * Create and initialize an anonymous wordlist
481afc2ba1dSToomas Soome  */
482afc2ba1dSToomas Soome ficlHash *
ficlDictionaryCreateWordlist(ficlDictionary * dictionary,int bucketCount)483afc2ba1dSToomas Soome ficlDictionaryCreateWordlist(ficlDictionary *dictionary, int bucketCount)
484afc2ba1dSToomas Soome {
485afc2ba1dSToomas Soome 	ficlHash *hash;
486afc2ba1dSToomas Soome 
487afc2ba1dSToomas Soome 	ficlDictionaryAlign(dictionary);
488afc2ba1dSToomas Soome 	hash = (ficlHash *)dictionary->here;
489afc2ba1dSToomas Soome 	ficlDictionaryAllot(dictionary,
490afc2ba1dSToomas Soome 	    sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *));
491afc2ba1dSToomas Soome 
492afc2ba1dSToomas Soome 	hash->size = bucketCount;
493afc2ba1dSToomas Soome 	ficlHashReset(hash);
494afc2ba1dSToomas Soome 	return (hash);
495afc2ba1dSToomas Soome }
496afc2ba1dSToomas Soome 
497afc2ba1dSToomas Soome /*
498afc2ba1dSToomas Soome  * d i c t D e l e t e
499afc2ba1dSToomas Soome  * Free all memory allocated for the given dictionary
500afc2ba1dSToomas Soome  */
501afc2ba1dSToomas Soome void
ficlDictionaryDestroy(ficlDictionary * dictionary)502afc2ba1dSToomas Soome ficlDictionaryDestroy(ficlDictionary *dictionary)
503afc2ba1dSToomas Soome {
504afc2ba1dSToomas Soome 	FICL_DICTIONARY_ASSERT(dictionary, dictionary != NULL);
505afc2ba1dSToomas Soome 	ficlFree(dictionary);
506afc2ba1dSToomas Soome }
507afc2ba1dSToomas Soome 
508afc2ba1dSToomas Soome /*
509afc2ba1dSToomas Soome  * d i c t E m p t y
510afc2ba1dSToomas Soome  * Empty the dictionary, reset its hash table, and reset its search order.
511afc2ba1dSToomas Soome  * Clears and (re-)creates the hash table with the size specified by nHash.
512afc2ba1dSToomas Soome  */
513afc2ba1dSToomas Soome void
ficlDictionaryEmpty(ficlDictionary * dictionary,unsigned bucketCount)514afc2ba1dSToomas Soome ficlDictionaryEmpty(ficlDictionary *dictionary, unsigned bucketCount)
515afc2ba1dSToomas Soome {
516afc2ba1dSToomas Soome 	ficlHash *hash;
517afc2ba1dSToomas Soome 
518afc2ba1dSToomas Soome 	dictionary->here = dictionary->base;
519afc2ba1dSToomas Soome 
520afc2ba1dSToomas Soome 	ficlDictionaryAlign(dictionary);
521afc2ba1dSToomas Soome 	hash = (ficlHash *)dictionary->here;
522afc2ba1dSToomas Soome 	ficlDictionaryAllot(dictionary,
523afc2ba1dSToomas Soome 	    sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *));
524afc2ba1dSToomas Soome 
525afc2ba1dSToomas Soome 	hash->size = bucketCount;
526afc2ba1dSToomas Soome 	ficlHashReset(hash);
527afc2ba1dSToomas Soome 
528afc2ba1dSToomas Soome 	dictionary->forthWordlist = hash;
529afc2ba1dSToomas Soome 	dictionary->smudge = NULL;
530afc2ba1dSToomas Soome 	ficlDictionaryResetSearchOrder(dictionary);
531afc2ba1dSToomas Soome }
532afc2ba1dSToomas Soome 
533afc2ba1dSToomas Soome /*
534afc2ba1dSToomas Soome  * i s A F i c l W o r d
535afc2ba1dSToomas Soome  * Vet a candidate pointer carefully to make sure
536afc2ba1dSToomas Soome  * it's not some chunk o' inline data...
537afc2ba1dSToomas Soome  * It has to have a name, and it has to look
538afc2ba1dSToomas Soome  * like it's in the dictionary address range.
539afc2ba1dSToomas Soome  * NOTE: this excludes :noname words!
540afc2ba1dSToomas Soome  */
541afc2ba1dSToomas Soome int
ficlDictionaryIsAWord(ficlDictionary * dictionary,ficlWord * word)542afc2ba1dSToomas Soome ficlDictionaryIsAWord(ficlDictionary *dictionary, ficlWord *word)
543afc2ba1dSToomas Soome {
544afc2ba1dSToomas Soome 	if ((((ficlInstruction)word) > ficlInstructionInvalid) &&
545afc2ba1dSToomas Soome 	    (((ficlInstruction)word) < ficlInstructionLast))
546afc2ba1dSToomas Soome 		return (1);
547afc2ba1dSToomas Soome 
548afc2ba1dSToomas Soome 	if (!ficlDictionaryIncludes(dictionary, word))
549afc2ba1dSToomas Soome 		return (0);
550afc2ba1dSToomas Soome 
551afc2ba1dSToomas Soome 	if (!ficlDictionaryIncludes(dictionary, word->name))
552afc2ba1dSToomas Soome 		return (0);
553afc2ba1dSToomas Soome 
554afc2ba1dSToomas Soome 	if ((word->link != NULL) &&
555afc2ba1dSToomas Soome 	    !ficlDictionaryIncludes(dictionary, word->link))
556afc2ba1dSToomas Soome 		return (0);
557afc2ba1dSToomas Soome 
558afc2ba1dSToomas Soome 	if ((word->length <= 0) || (word->name[word->length] != '\0'))
559afc2ba1dSToomas Soome 		return (0);
560afc2ba1dSToomas Soome 
561afc2ba1dSToomas Soome 	if (strlen(word->name) != word->length)
562afc2ba1dSToomas Soome 		return (0);
563afc2ba1dSToomas Soome 
564afc2ba1dSToomas Soome 	return (1);
565afc2ba1dSToomas Soome }
566afc2ba1dSToomas Soome 
567afc2ba1dSToomas Soome /*
568afc2ba1dSToomas Soome  * f i n d E n c l o s i n g W o r d
569afc2ba1dSToomas Soome  * Given a pointer to something, check to make sure it's an address in the
570afc2ba1dSToomas Soome  * dictionary. If so, search backwards until we find something that looks
571afc2ba1dSToomas Soome  * like a dictionary header. If successful, return the address of the
572afc2ba1dSToomas Soome  * ficlWord found. Otherwise return NULL. nSEARCH_CELLS sets the maximum
573afc2ba1dSToomas Soome  * neighborhood this func will search before giving up
574afc2ba1dSToomas Soome  */
575afc2ba1dSToomas Soome #define	nSEARCH_CELLS	100
576afc2ba1dSToomas Soome 
577afc2ba1dSToomas Soome ficlWord *
ficlDictionaryFindEnclosingWord(ficlDictionary * dictionary,ficlCell * cell)578afc2ba1dSToomas Soome ficlDictionaryFindEnclosingWord(ficlDictionary *dictionary, ficlCell *cell)
579afc2ba1dSToomas Soome {
580afc2ba1dSToomas Soome 	ficlWord *word;
581afc2ba1dSToomas Soome 	int i;
582afc2ba1dSToomas Soome 
583afc2ba1dSToomas Soome 	if (!ficlDictionaryIncludes(dictionary, (void *)cell))
584afc2ba1dSToomas Soome 		return (NULL);
585afc2ba1dSToomas Soome 
586afc2ba1dSToomas Soome 	for (i = nSEARCH_CELLS; i > 0; --i, --cell) {
587afc2ba1dSToomas Soome 		word = (ficlWord *)
588afc2ba1dSToomas Soome 		    (cell + 1 - (sizeof (ficlWord) / sizeof (ficlCell)));
589afc2ba1dSToomas Soome 		if (ficlDictionaryIsAWord(dictionary, word))
590afc2ba1dSToomas Soome 			return (word);
591afc2ba1dSToomas Soome 	}
592afc2ba1dSToomas Soome 
593afc2ba1dSToomas Soome 	return (NULL);
594afc2ba1dSToomas Soome }
595afc2ba1dSToomas Soome 
596afc2ba1dSToomas Soome /*
597afc2ba1dSToomas Soome  * d i c t I n c l u d e s
598afc2ba1dSToomas Soome  * Returns FICL_TRUE iff the given pointer is within the address range of
599afc2ba1dSToomas Soome  * the dictionary.
600afc2ba1dSToomas Soome  */
601afc2ba1dSToomas Soome int
ficlDictionaryIncludes(ficlDictionary * dictionary,void * p)602afc2ba1dSToomas Soome ficlDictionaryIncludes(ficlDictionary *dictionary, void *p)
603afc2ba1dSToomas Soome {
604afc2ba1dSToomas Soome 	return ((p >= (void *) &dictionary->base) &&
605afc2ba1dSToomas Soome 	    (p <  (void *)(&dictionary->base + dictionary->size)));
606afc2ba1dSToomas Soome }
607afc2ba1dSToomas Soome 
608afc2ba1dSToomas Soome /*
609afc2ba1dSToomas Soome  * d i c t L o o k u p
610afc2ba1dSToomas Soome  * Find the ficlWord that matches the given name and length.
611afc2ba1dSToomas Soome  * If found, returns the word's address. Otherwise returns NULL.
612afc2ba1dSToomas Soome  * Uses the search order list to search multiple wordlists.
613afc2ba1dSToomas Soome  */
614afc2ba1dSToomas Soome ficlWord *
ficlDictionaryLookup(ficlDictionary * dictionary,ficlString name)615afc2ba1dSToomas Soome ficlDictionaryLookup(ficlDictionary *dictionary, ficlString name)
616afc2ba1dSToomas Soome {
617afc2ba1dSToomas Soome 	ficlWord *word = NULL;
618afc2ba1dSToomas Soome 	ficlHash *hash;
619afc2ba1dSToomas Soome 	int i;
620afc2ba1dSToomas Soome 	ficlUnsigned16 hashCode = ficlHashCode(name);
621afc2ba1dSToomas Soome 
622afc2ba1dSToomas Soome 	FICL_DICTIONARY_ASSERT(dictionary, dictionary != NULL);
623afc2ba1dSToomas Soome 
624afc2ba1dSToomas Soome 	ficlDictionaryLock(dictionary, FICL_TRUE);
625afc2ba1dSToomas Soome 
626afc2ba1dSToomas Soome 	for (i = (int)dictionary->wordlistCount - 1; (i >= 0) && (!word); --i) {
627afc2ba1dSToomas Soome 		hash = dictionary->wordlists[i];
628afc2ba1dSToomas Soome 		word = ficlHashLookup(hash, name, hashCode);
629afc2ba1dSToomas Soome 	}
630afc2ba1dSToomas Soome 
631afc2ba1dSToomas Soome 	ficlDictionaryLock(dictionary, FICL_FALSE);
632afc2ba1dSToomas Soome 	return (word);
633afc2ba1dSToomas Soome }
634afc2ba1dSToomas Soome 
635afc2ba1dSToomas Soome /*
636afc2ba1dSToomas Soome  * s e e
637afc2ba1dSToomas Soome  * TOOLS ( "<spaces>name" -- )
638afc2ba1dSToomas Soome  * Display a human-readable representation of the named word's definition.
639afc2ba1dSToomas Soome  * The source of the representation (object-code decompilation, source
640afc2ba1dSToomas Soome  * block, etc.) and the particular form of the display is implementation
641afc2ba1dSToomas Soome  * defined.
642afc2ba1dSToomas Soome  */
643afc2ba1dSToomas Soome /*
644afc2ba1dSToomas Soome  * ficlSeeColon (for proctologists only)
645afc2ba1dSToomas Soome  * Walks a colon definition, decompiling
646afc2ba1dSToomas Soome  * on the fly. Knows about primitive control structures.
647afc2ba1dSToomas Soome  */
648afc2ba1dSToomas Soome char *ficlDictionaryInstructionNames[] =
649afc2ba1dSToomas Soome {
650afc2ba1dSToomas Soome #define	FICL_TOKEN(token, description)	description,
651afc2ba1dSToomas Soome #define	FICL_INSTRUCTION_TOKEN(token, description, flags)	description,
652afc2ba1dSToomas Soome #include "ficltokens.h"
653afc2ba1dSToomas Soome #undef FICL_TOKEN
654afc2ba1dSToomas Soome #undef FICL_INSTRUCTION_TOKEN
655afc2ba1dSToomas Soome };
656afc2ba1dSToomas Soome 
657afc2ba1dSToomas Soome void
ficlDictionarySee(ficlDictionary * dictionary,ficlWord * word,ficlCallback * callback)658afc2ba1dSToomas Soome ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word,
659afc2ba1dSToomas Soome     ficlCallback *callback)
660afc2ba1dSToomas Soome {
661afc2ba1dSToomas Soome 	char *trace;
662afc2ba1dSToomas Soome 	ficlCell *cell = word->param;
663afc2ba1dSToomas Soome 	ficlCell *param0 = cell;
664afc2ba1dSToomas Soome 	char buffer[128];
665afc2ba1dSToomas Soome 
666afc2ba1dSToomas Soome 	for (; cell->i != ficlInstructionSemiParen; cell++) {
667afc2ba1dSToomas Soome 		ficlWord *word = (ficlWord *)(cell->p);
668afc2ba1dSToomas Soome 
669afc2ba1dSToomas Soome 		trace = buffer;
670afc2ba1dSToomas Soome 		if ((void *)cell == (void *)buffer)
671afc2ba1dSToomas Soome 			*trace++ = '>';
672afc2ba1dSToomas Soome 		else
673afc2ba1dSToomas Soome 			*trace++ = ' ';
674afc2ba1dSToomas Soome 		trace += sprintf(trace, "%3ld   ", (long)(cell - param0));
675afc2ba1dSToomas Soome 
676afc2ba1dSToomas Soome 		if (ficlDictionaryIsAWord(dictionary, word)) {
677afc2ba1dSToomas Soome 			ficlWordKind kind = ficlWordClassify(word);
678afc2ba1dSToomas Soome 			ficlCell c, c2;
679afc2ba1dSToomas Soome 
680afc2ba1dSToomas Soome 			switch (kind) {
681afc2ba1dSToomas Soome 			case FICL_WORDKIND_INSTRUCTION:
682*c0bb4f73SToomas Soome 				(void) sprintf(trace, "%s (instruction %ld)",
683afc2ba1dSToomas Soome 				    ficlDictionaryInstructionNames[(long)word],
684afc2ba1dSToomas Soome 				    (long)word);
685afc2ba1dSToomas Soome 			break;
686afc2ba1dSToomas Soome 			case FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT:
687afc2ba1dSToomas Soome 				c = *++cell;
688*c0bb4f73SToomas Soome 				(void) sprintf(trace, "%s (instruction %ld), "
689*c0bb4f73SToomas Soome 				    "with argument %ld (%#lx)",
690afc2ba1dSToomas Soome 				    ficlDictionaryInstructionNames[(long)word],
691afc2ba1dSToomas Soome 				    (long)word, (long)c.i, (unsigned long)c.u);
692afc2ba1dSToomas Soome 			break;
693afc2ba1dSToomas Soome 			case FICL_WORDKIND_INSTRUCTION_WORD:
694*c0bb4f73SToomas Soome 				(void) sprintf(trace,
695afc2ba1dSToomas Soome 				    "%s :: executes %s (instruction word %ld)",
696afc2ba1dSToomas Soome 				    word->name,
697afc2ba1dSToomas Soome 				    ficlDictionaryInstructionNames[
698afc2ba1dSToomas Soome 				    (long)word->code], (long)word->code);
699afc2ba1dSToomas Soome 			break;
700afc2ba1dSToomas Soome 			case FICL_WORDKIND_LITERAL:
701afc2ba1dSToomas Soome 				c = *++cell;
702afc2ba1dSToomas Soome 				if (ficlDictionaryIsAWord(dictionary, c.p) &&
703afc2ba1dSToomas Soome 				    (c.i >= ficlInstructionLast)) {
704afc2ba1dSToomas Soome 					ficlWord *word = (ficlWord *)c.p;
705*c0bb4f73SToomas Soome 					(void) sprintf(trace,
706*c0bb4f73SToomas Soome 					    "%.*s ( %#lx literal )",
707afc2ba1dSToomas Soome 					    word->length, word->name,
708afc2ba1dSToomas Soome 					    (unsigned long)c.u);
709afc2ba1dSToomas Soome 				} else
710*c0bb4f73SToomas Soome 					(void) sprintf(trace,
711afc2ba1dSToomas Soome 					    "literal %ld (%#lx)", (long)c.i,
712afc2ba1dSToomas Soome 					    (unsigned long)c.u);
713afc2ba1dSToomas Soome 			break;
714afc2ba1dSToomas Soome 			case FICL_WORDKIND_2LITERAL:
715afc2ba1dSToomas Soome 				c = *++cell;
716afc2ba1dSToomas Soome 				c2 = *++cell;
717*c0bb4f73SToomas Soome 				(void) sprintf(trace,
718*c0bb4f73SToomas Soome 				    "2literal %ld %ld (%#lx %#lx)",
719afc2ba1dSToomas Soome 				    (long)c2.i, (long)c.i, (unsigned long)c2.u,
720afc2ba1dSToomas Soome 				    (unsigned long)c.u);
721afc2ba1dSToomas Soome 			break;
722afc2ba1dSToomas Soome #if FICL_WANT_FLOAT
723afc2ba1dSToomas Soome 			case FICL_WORDKIND_FLITERAL:
724afc2ba1dSToomas Soome 				c = *++cell;
725*c0bb4f73SToomas Soome 				(void) sprintf(trace, "fliteral %f (%#lx)",
726afc2ba1dSToomas Soome 				    (double)c.f, (unsigned long)c.u);
727afc2ba1dSToomas Soome 			break;
728afc2ba1dSToomas Soome #endif /* FICL_WANT_FLOAT */
729afc2ba1dSToomas Soome 			case FICL_WORDKIND_STRING_LITERAL: {
730afc2ba1dSToomas Soome 				ficlCountedString *counted;
731afc2ba1dSToomas Soome 				counted = (ficlCountedString *)(void *)++cell;
732afc2ba1dSToomas Soome 				cell = (ficlCell *)
733afc2ba1dSToomas Soome 				    ficlAlignPointer(counted->text +
734afc2ba1dSToomas Soome 				    counted->length + 1) - 1;
735*c0bb4f73SToomas Soome 				(void) sprintf(trace, "s\" %.*s\"",
736*c0bb4f73SToomas Soome 				    counted->length, counted->text);
737afc2ba1dSToomas Soome 			}
738afc2ba1dSToomas Soome 			break;
739afc2ba1dSToomas Soome 			case FICL_WORDKIND_CSTRING_LITERAL: {
740afc2ba1dSToomas Soome 				ficlCountedString *counted;
741afc2ba1dSToomas Soome 				counted = (ficlCountedString *)(void *)++cell;
742afc2ba1dSToomas Soome 				cell = (ficlCell *)
743afc2ba1dSToomas Soome 				    ficlAlignPointer(counted->text +
744afc2ba1dSToomas Soome 				    counted->length + 1) - 1;
745*c0bb4f73SToomas Soome 				(void) sprintf(trace, "c\" %.*s\"",
746*c0bb4f73SToomas Soome 				    counted->length, counted->text);
747afc2ba1dSToomas Soome 			}
748afc2ba1dSToomas Soome 			break;
749afc2ba1dSToomas Soome 			case FICL_WORDKIND_BRANCH0:
750afc2ba1dSToomas Soome 				c = *++cell;
751*c0bb4f73SToomas Soome 				(void) sprintf(trace, "branch0 %ld",
752afc2ba1dSToomas Soome 				    (long)(cell + c.i - param0));
753afc2ba1dSToomas Soome 			break;
754afc2ba1dSToomas Soome 			case FICL_WORDKIND_BRANCH:
755afc2ba1dSToomas Soome 				c = *++cell;
756*c0bb4f73SToomas Soome 				(void) sprintf(trace, "branch %ld",
757afc2ba1dSToomas Soome 				    (long)(cell + c.i - param0));
758afc2ba1dSToomas Soome 			break;
759afc2ba1dSToomas Soome 
760afc2ba1dSToomas Soome 			case FICL_WORDKIND_QDO:
761afc2ba1dSToomas Soome 				c = *++cell;
762*c0bb4f73SToomas Soome 				(void) sprintf(trace, "?do (leave %ld)",
763afc2ba1dSToomas Soome 				    (long)((ficlCell *)c.p - param0));
764afc2ba1dSToomas Soome 			break;
765afc2ba1dSToomas Soome 			case FICL_WORDKIND_DO:
766afc2ba1dSToomas Soome 				c = *++cell;
767*c0bb4f73SToomas Soome 				(void) sprintf(trace, "do (leave %ld)",
768afc2ba1dSToomas Soome 				    (long)((ficlCell *)c.p - param0));
769afc2ba1dSToomas Soome 			break;
770afc2ba1dSToomas Soome 			case FICL_WORDKIND_LOOP:
771afc2ba1dSToomas Soome 				c = *++cell;
772*c0bb4f73SToomas Soome 				(void) sprintf(trace, "loop (branch %ld)",
773afc2ba1dSToomas Soome 				    (long)(cell + c.i - param0));
774afc2ba1dSToomas Soome 			break;
775afc2ba1dSToomas Soome 			case FICL_WORDKIND_OF:
776afc2ba1dSToomas Soome 				c = *++cell;
777*c0bb4f73SToomas Soome 				(void) sprintf(trace, "of (branch %ld)",
778afc2ba1dSToomas Soome 				    (long)(cell + c.i - param0));
779afc2ba1dSToomas Soome 			break;
780afc2ba1dSToomas Soome 			case FICL_WORDKIND_PLOOP:
781afc2ba1dSToomas Soome 				c = *++cell;
782*c0bb4f73SToomas Soome 				(void) sprintf(trace, "+loop (branch %ld)",
783afc2ba1dSToomas Soome 				    (long)(cell + c.i - param0));
784afc2ba1dSToomas Soome 			break;
785afc2ba1dSToomas Soome 			default:
786*c0bb4f73SToomas Soome 				(void) sprintf(trace, "%.*s", word->length,
787afc2ba1dSToomas Soome 				    word->name);
788afc2ba1dSToomas Soome 			break;
789afc2ba1dSToomas Soome 			}
790