1/*
2 * p r e f i x . c
3 * Forth Inspired Command Language
4 * Parser extensions for Ficl
5 * Authors: Larry Hastings & John Sadler (john_sadler@alum.mit.edu)
6 * Created: April 2001
7 * $Id: prefix.c,v 1.8 2010/09/13 18:43:04 asau Exp $
8 */
9/*
10 * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
11 * All rights reserved.
12 *
13 * Get the latest Ficl release at http://ficl.sourceforge.net
14 *
15 * I am interested in hearing from anyone who uses Ficl. If you have
16 * a problem, a success story, a defect, an enhancement request, or
17 * if you would like to contribute to the Ficl release, please
18 * contact me by email at the address above.
19 *
20 * L I C E N S E  and  D I S C L A I M E R
21 *
22 * Redistribution and use in source and binary forms, with or without
23 * modification, are permitted provided that the following conditions
24 * are met:
25 * 1. Redistributions of source code must retain the above copyright
26 *    notice, this list of conditions and the following disclaimer.
27 * 2. Redistributions in binary form must reproduce the above copyright
28 *    notice, this list of conditions and the following disclaimer in the
29 *    documentation and/or other materials provided with the distribution.
30 *
31 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
32 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
33 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
34 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
35 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
36 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
37 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
38 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
39 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
40 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
41 * SUCH DAMAGE.
42 */
43
44#include "ficl.h"
45
46/*
47 * (jws) revisions:
48 * A prefix is a word in a dedicated wordlist (name stored in list_name below)
49 * that is searched in a special way by the prefix parse step. When a prefix
50 * matches the beginning of an incoming token, push the non-prefix part of the
51 * token back onto the input stream and execute the prefix code.
52 *
53 * The parse step is called ficlParsePrefix.
54 * Storing prefix entries in the dictionary greatly simplifies
55 * the process of matching and dispatching prefixes, avoids the
56 * need to clean up a dynamically allocated prefix list when the system
57 * goes away, but still allows prefixes to be allocated at runtime.
58 */
59
60static char list_name[] = "<prefixes>";
61
62/*
63 * f i c l P a r s e P r e f i x
64 * This is the parse step for prefixes - it checks an incoming word
65 * to see if it starts with a prefix, and if so runs the corresponding
66 * code against the remainder of the word and returns true.
67 */
68int
69ficlVmParsePrefix(ficlVm *vm, ficlString s)
70{
71	int i;
72	ficlHash *hash;
73	ficlWord *word = ficlSystemLookup(vm->callback.system, list_name);
74
75	/*
76	 * Make sure we found the prefix dictionary - otherwise silently fail
77	 * If forth-wordlist is not in the search order, we won't find the
78	 * prefixes.
79	 */
80	if (!word)
81		return (0); /* false */
82
83	hash = (ficlHash *)(word->param[0].p);
84	/*
85	 * Walk the list looking for a match with the beginning of the
86	 * incoming token
87	 */
88	for (i = 0; i < (int)hash->size; i++) {
89		word = hash->table[i];
90		while (word != NULL) {
91			int n;
92			n = word->length;
93			/*
94			 * If we find a match, adjust the TIB to give back
95			 * the non-prefix characters and execute the prefix
96			 * word.
97			 */
98			if (!ficlStrincmp(FICL_STRING_GET_POINTER(s),
99			    word->name, (ficlUnsigned)n)) {
100				/*
101				 * (sadler) fixed off-by-one error when the
102				 * token has no trailing space in the TIB
103				 */
104				ficlVmSetTibIndex(vm,
105				    s.text + n - vm->tib.text);
106				ficlVmExecuteWord(vm, word);
107
108				return (1); /* true */
109			}
110			word = word->link;
111		}
112	}
113
114	return (0); /* false */
115}
116
117static void
118ficlPrimitiveTempBase(ficlVm *vm)
119{
120	int oldbase = vm->base;
121	ficlString number = ficlVmGetWord0(vm);
122	int base = ficlStackPopInteger(vm->dataStack);
123
124	vm->base = base;
125	if (!ficlVmParseNumber(vm, number))
126		ficlVmThrowError(vm, "%.*s not recognized",
127		    FICL_STRING_GET_LENGTH(number),
128		    FICL_STRING_GET_POINTER(number));
129
130	vm->base = oldbase;
131}
132
133/*
134 * f i c l C o m p i l e P r e f i x
135 * Build prefix support into the dictionary and the parser
136 * Note: since prefixes always execute, they are effectively IMMEDIATE.
137 * If they need to generate code in compile state you must add
138 * this code explicitly.
139 */
140void
141ficlSystemCompilePrefix(ficlSystem *system)
142{
143	ficlDictionary *dictionary = system->dictionary;
144	ficlHash *hash;
145
146	/*
147	 * Create a named wordlist for prefixes to reside in...
148	 * Since we're doing a special kind of search, make it
149	 * a single bucket hashtable - hashing does not help here.
150	 */
151	hash = ficlDictionaryCreateWordlist(dictionary, 1);
152	hash->name = list_name;
153	ficlDictionaryAppendConstantPointer(dictionary, list_name, hash);
154
155	/*
156	 * Put __tempbase in the forth-wordlist
157	 */
158	(void) ficlDictionarySetPrimitive(dictionary, "__tempbase",
159	    ficlPrimitiveTempBase, FICL_WORD_DEFAULT);
160
161	/*
162	 * If you want to add some prefixes at compilation-time, copy this
163	 * line to the top of this function:
164	 *
165	 * ficlHash *oldCompilationWordlist;
166	 *
167	 * then copy this code to the bottom, just above the return:
168	 *
169	 *
170	 * oldCompilationWordlist = dictionary->compilationWordlist;
171	 * dictionary->compilationWordlist = hash;
172	 * ficlDictionarySetPrimitive(dictionary, YOUR WORD HERE,
173	 * FICL_WORD_DEFAULT);
174	 * dictionary->compilationWordlist = oldCompilationWordlist;
175	 *
176	 * and substitute in your own actual calls to
177	 * ficlDictionarySetPrimitive() as needed.
178	 *
179	 * Or--better yet--do it in your own code, so you don't have
180	 * to re-modify the Ficl source code every time we cut a new release!
181	 */
182}
183