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.6 2001/12/05 07:21:34 jsadler 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
45 #include <string.h>
46 #include <ctype.h>
47 #include "ficl.h"
48 #include "math64.h"
49
50 /*
51 ** (jws) revisions:
52 ** A prefix is a word in a dedicated wordlist (name stored in list_name below)
53 ** that is searched in a special way by the prefix parse step. When a prefix
54 ** matches the beginning of an incoming token, push the non-prefix part of the
55 ** token back onto the input stream and execute the prefix code.
56 **
57 ** The parse step is called ficlParsePrefix.
58 ** Storing prefix entries in the dictionary greatly simplifies
59 ** the process of matching and dispatching prefixes, avoids the
60 ** need to clean up a dynamically allocated prefix list when the system
61 ** goes away, but still allows prefixes to be allocated at runtime.
62 */
63
64 static char list_name[] = "<prefixes>";
65
66 /**************************************************************************
67 f i c l P a r s e P r e f i x
68 ** This is the parse step for prefixes - it checks an incoming word
69 ** to see if it starts with a prefix, and if so runs the corrseponding
70 ** code against the remainder of the word and returns true.
71 **************************************************************************/
ficlParsePrefix(FICL_VM * pVM,STRINGINFO si)72 int ficlParsePrefix(FICL_VM *pVM, STRINGINFO si)
73 {
74 int i;
75 FICL_HASH *pHash;
76 FICL_WORD *pFW = ficlLookup(pVM->pSys, list_name);
77
78 /*
79 ** Make sure we found the prefix dictionary - otherwise silently fail
80 ** If forth-wordlist is not in the search order, we won't find the prefixes.
81 */
82 if (!pFW)
83 return FICL_FALSE;
84
85 pHash = (FICL_HASH *)(pFW->param[0].p);
86 /*
87 ** Walk the list looking for a match with the beginning of the incoming token
88 */
89 for (i = 0; i < (int)pHash->size; i++)
90 {
91 pFW = pHash->table[i];
92 while (pFW != NULL)
93 {
94 int n;
95 n = pFW->nName;
96 /*
97 ** If we find a match, adjust the TIB to give back the non-prefix characters
98 ** and execute the prefix word.
99 */
100 if (!strincmp(SI_PTR(si), pFW->name, (FICL_UNS)n))
101 {
102 /* (sadler) fixed off-by-one error when the token has no trailing space in the TIB */
103 vmSetTibIndex(pVM, si.cp + n - pVM->tib.cp );
104 vmExecute(pVM, pFW);
105
106 return (int)FICL_TRUE;
107 }
108 pFW = pFW->link;
109 }
110 }
111
112 return FICL_FALSE;
113 }
114
115
tempBase(FICL_VM * pVM,int base)116 static void tempBase(FICL_VM *pVM, int base)
117 {
118 int oldbase = pVM->base;
119 STRINGINFO si = vmGetWord0(pVM);
120
121 pVM->base = base;
122 if (!ficlParseNumber(pVM, si))
123 {
124 int i = SI_COUNT(si);
125 vmThrowErr(pVM, "%.*s not recognized", i, SI_PTR(si));
126 }
127
128 pVM->base = oldbase;
129 return;
130 }
131
fTempBase(FICL_VM * pVM)132 static void fTempBase(FICL_VM *pVM)
133 {
134 int base = stackPopINT(pVM->pStack);
135 tempBase(pVM, base);
136 return;
137 }
138
prefixHex(FICL_VM * pVM)139 static void prefixHex(FICL_VM *pVM)
140 {
141 tempBase(pVM, 16);
142 }
143
prefixTen(FICL_VM * pVM)144 static void prefixTen(FICL_VM *pVM)
145 {
146 tempBase(pVM, 10);
147 }
148
149
150 /**************************************************************************
151 f i c l C o m p i l e P r e f i x
152 ** Build prefix support into the dictionary and the parser
153 ** Note: since prefixes always execute, they are effectively IMMEDIATE.
154 ** If they need to generate code in compile state you must add
155 ** this code explicitly.
156 **************************************************************************/
ficlCompilePrefix(FICL_SYSTEM * pSys)157 void ficlCompilePrefix(FICL_SYSTEM *pSys)
158 {
159 FICL_DICT *dp = pSys->dp;
160 FICL_HASH *pHash;
161 FICL_HASH *pPrevCompile = dp->pCompile;
162 #if (FICL_EXTENDED_PREFIX)
163 FICL_WORD *pFW;
164 #endif
165
166 /*
167 ** Create a named wordlist for prefixes to reside in...
168 ** Since we're doing a special kind of search, make it
169 ** a single bucket hashtable - hashing does not help here.
170 */
171 pHash = dictCreateWordlist(dp, 1);
172 pHash->name = list_name;
173 dictAppendWord(dp, list_name, constantParen, FW_DEFAULT);
174 dictAppendCell(dp, LVALUEtoCELL(pHash));
175
176 /*
177 ** Put __tempbase in the forth-wordlist
178 */
179 dictAppendWord(dp, "__tempbase", fTempBase, FW_DEFAULT);
180
181 /*
182 ** Temporarily make the prefix list the compile wordlist so that
183 ** we can create some precompiled prefixes.
184 */
185 dp->pCompile = pHash;
186 dictAppendWord(dp, "0x", prefixHex, FW_DEFAULT);
187 dictAppendWord(dp, "0d", prefixTen, FW_DEFAULT);
188 #if (FICL_EXTENDED_PREFIX)
189 pFW = ficlLookup(pSys, "\\");
190 if (pFW)
191 {
192 dictAppendWord(dp, "//", pFW->code, FW_DEFAULT);
193 }
194 #endif
195 dp->pCompile = pPrevCompile;
196
197 return;
198 }
199