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