Deleted Added
sdiff udiff text old ( 76116 ) new ( 94290 )
full compact
testmain.c (76116) testmain.c (94290)
1/*
1/*
2** stub main for testing FICL under Win32
3** $Id: testmain.c,v 1.6 2000-06-17 07:43:50-07 jsadler Exp jsadler $
2** stub main for testing FICL under userland
3** $Id: testmain.c,v 1.13 2001/12/05 07:21:34 jsadler Exp $
4*/
4*/
5/*
6** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
7** All rights reserved.
8**
9** Get the latest Ficl release at http://ficl.sourceforge.net
10**
11** I am interested in hearing from anyone who uses ficl. If you have
12** a problem, a success story, a defect, an enhancement request, or
13** if you would like to contribute to the ficl release, please
14** contact me by email at the address above.
15**
16** L I C E N S E and D I S C L A I M E R
17**
18** Redistribution and use in source and binary forms, with or without
19** modification, are permitted provided that the following conditions
20** are met:
21** 1. Redistributions of source code must retain the above copyright
22** notice, this list of conditions and the following disclaimer.
23** 2. Redistributions in binary form must reproduce the above copyright
24** notice, this list of conditions and the following disclaimer in the
25** documentation and/or other materials provided with the distribution.
26**
27** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
28** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
29** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
30** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
31** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
32** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
35** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
36** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
37** SUCH DAMAGE.
38*/
5
39
6/* $FreeBSD: head/sys/boot/ficl/testmain.c 76116 2001-04-29 02:36:36Z dcs $ */
40/* $FreeBSD: head/sys/boot/ficl/testmain.c 94290 2002-04-09 17:45:28Z dcs $ */
7
8#include <stdlib.h>
9#include <stdio.h>
10#include <string.h>
11#include <time.h>
12#include <sys/types.h>
13#include <sys/stat.h>
14#include <unistd.h>

--- 4 unchanged lines hidden (view full) ---

19** Ficl interface to getcwd
20** Prints the current working directory using the VM's
21** textOut method...
22*/
23static void ficlGetCWD(FICL_VM *pVM)
24{
25 char *cp;
26
41
42#include <stdlib.h>
43#include <stdio.h>
44#include <string.h>
45#include <time.h>
46#include <sys/types.h>
47#include <sys/stat.h>
48#include <unistd.h>

--- 4 unchanged lines hidden (view full) ---

53** Ficl interface to getcwd
54** Prints the current working directory using the VM's
55** textOut method...
56*/
57static void ficlGetCWD(FICL_VM *pVM)
58{
59 char *cp;
60
27 cp = getcwd(NULL, 80);
61 cp = getcwd(NULL, 80);
28 vmTextOut(pVM, cp, 1);
29 free(cp);
30 return;
31}
32
33/*
34** Ficl interface to chdir
35** Gets a newline (or NULL) delimited string from the input

--- 21 unchanged lines hidden (view full) ---

57 return;
58}
59
60/*
61** Ficl interface to system (ANSI)
62** Gets a newline (or NULL) delimited string from the input
63** and feeds it to system()
64** Example:
62 vmTextOut(pVM, cp, 1);
63 free(cp);
64 return;
65}
66
67/*
68** Ficl interface to chdir
69** Gets a newline (or NULL) delimited string from the input

--- 21 unchanged lines hidden (view full) ---

91 return;
92}
93
94/*
95** Ficl interface to system (ANSI)
96** Gets a newline (or NULL) delimited string from the input
97** and feeds it to system()
98** Example:
65** system del *.*
99** system rm -rf /
66** \ ouch!
67*/
68static void ficlSystem(FICL_VM *pVM)
69{
70 FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
71
72 vmGetString(pVM, pFS, '\n');
73 if (pFS->count > 0)

--- 71 unchanged lines hidden (view full) ---

145
146 nLine++;
147 if (len <= 0)
148 continue;
149
150 result = ficlExecC(pVM, cp, len);
151 if (result != VM_QUIT && result != VM_USEREXIT && result != VM_OUTOFTEXT )
152 {
100** \ ouch!
101*/
102static void ficlSystem(FICL_VM *pVM)
103{
104 FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
105
106 vmGetString(pVM, pFS, '\n');
107 if (pFS->count > 0)

--- 71 unchanged lines hidden (view full) ---

179
180 nLine++;
181 if (len <= 0)
182 continue;
183
184 result = ficlExecC(pVM, cp, len);
185 if (result != VM_QUIT && result != VM_USEREXIT && result != VM_OUTOFTEXT )
186 {
153 pVM->sourceID = id;
154 fclose(fp);
155 vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);
156 break;
187 pVM->sourceID = id;
188 fclose(fp);
189 vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);
190 break;
157 }
158 }
159 /*
160 ** Pass an empty line with SOURCE-ID == -1 to flush
161 ** any pending REFILLs (as required by FILE wordset)
162 */
163 pVM->sourceID.i = -1;
164 ficlExec(pVM, "");
165
166 pVM->sourceID = id;
167 fclose(fp);
168
191 }
192 }
193 /*
194 ** Pass an empty line with SOURCE-ID == -1 to flush
195 ** any pending REFILLs (as required by FILE wordset)
196 */
197 pVM->sourceID.i = -1;
198 ficlExec(pVM, "");
199
200 pVM->sourceID = id;
201 fclose(fp);
202
203 /* handle "bye" in loaded files. --lch */
204 if (result == VM_USEREXIT)
205 vmThrow(pVM, VM_USEREXIT);
169 return;
170}
171
172/*
173** Dump a tab delimited file that summarizes the contents of the
174** dictionary hash table by hashcode...
175*/
176static void spewHash(FICL_VM *pVM)
177{
206 return;
207}
208
209/*
210** Dump a tab delimited file that summarizes the contents of the
211** dictionary hash table by hashcode...
212*/
213static void spewHash(FICL_VM *pVM)
214{
178 FICL_HASH *pHash = ficlGetDict()->pForthWords;
215 FICL_HASH *pHash = vmGetDict(pVM)->pForthWords;
179 FICL_WORD *pFW;
180 FILE *pOut;
181 unsigned i;
182 unsigned nHash = pHash->size;
183
184 if (!vmGetWordToPad(pVM))
185 vmThrow(pVM, VM_OUTOFTEXT);
186

--- 60 unchanged lines hidden (view full) ---

247
248 pFW = stackPopPtr(pVM->pStack);
249 ficlExecXT(pVM, pFW);
250
251 return;
252}
253
254
216 FICL_WORD *pFW;
217 FILE *pOut;
218 unsigned i;
219 unsigned nHash = pHash->size;
220
221 if (!vmGetWordToPad(pVM))
222 vmThrow(pVM, VM_OUTOFTEXT);
223

--- 60 unchanged lines hidden (view full) ---

284
285 pFW = stackPopPtr(pVM->pStack);
286 ficlExecXT(pVM, pFW);
287
288 return;
289}
290
291
255void buildTestInterface(void)
292void buildTestInterface(FICL_SYSTEM *pSys)
256{
293{
257 ficlBuild("break", ficlBreak, FW_DEFAULT);
258 ficlBuild("clock", ficlClock, FW_DEFAULT);
259 ficlBuild("cd", ficlChDir, FW_DEFAULT);
260 ficlBuild("execxt", execxt, FW_DEFAULT);
261 ficlBuild("load", ficlLoad, FW_DEFAULT);
262 ficlBuild("pwd", ficlGetCWD, FW_DEFAULT);
263 ficlBuild("system", ficlSystem, FW_DEFAULT);
264 ficlBuild("spewhash", spewHash, FW_DEFAULT);
265 ficlBuild("clocks/sec",
266 clocksPerSec, FW_DEFAULT);
294 ficlBuild(pSys, "break", ficlBreak, FW_DEFAULT);
295 ficlBuild(pSys, "clock", ficlClock, FW_DEFAULT);
296 ficlBuild(pSys, "cd", ficlChDir, FW_DEFAULT);
297 ficlBuild(pSys, "execxt", execxt, FW_DEFAULT);
298 ficlBuild(pSys, "load", ficlLoad, FW_DEFAULT);
299 ficlBuild(pSys, "pwd", ficlGetCWD, FW_DEFAULT);
300 ficlBuild(pSys, "system", ficlSystem, FW_DEFAULT);
301 ficlBuild(pSys, "spewhash", spewHash, FW_DEFAULT);
302 ficlBuild(pSys, "clocks/sec",
303 clocksPerSec, FW_DEFAULT);
267
268 return;
269}
270
271
272int main(int argc, char **argv)
273{
274 char in[256];
275 FICL_VM *pVM;
304
305 return;
306}
307
308
309int main(int argc, char **argv)
310{
311 char in[256];
312 FICL_VM *pVM;
313 FICL_SYSTEM *pSys;
276
314
277 ficlInitSystem(10000);
278 buildTestInterface();
279 pVM = ficlNewVM();
315 pSys = ficlInitSystem(10000);
316 buildTestInterface(pSys);
317 pVM = ficlNewVM(pSys);
280
318
281 ficlExec(pVM, ".ver .( " __DATE__ " ) cr quit");
319 ficlEvaluate(pVM, ".ver .( " __DATE__ " ) cr quit");
282
283 /*
284 ** load file from cmd line...
285 */
286 if (argc > 1)
287 {
288 sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
320
321 /*
322 ** load file from cmd line...
323 */
324 if (argc > 1)
325 {
326 sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
289 ficlExec(pVM, in);
327 ficlEvaluate(pVM, in);
290 }
291
292 for (;;)
293 {
294 int ret;
295 if (fgets(in, sizeof(in) - 1, stdin) == NULL)
296 break;
297 ret = ficlExec(pVM, in);
298 if (ret == VM_USEREXIT)
299 {
328 }
329
330 for (;;)
331 {
332 int ret;
333 if (fgets(in, sizeof(in) - 1, stdin) == NULL)
334 break;
335 ret = ficlExec(pVM, in);
336 if (ret == VM_USEREXIT)
337 {
300 ficlTermSystem();
338 ficlTermSystem(pSys);
301 break;
302 }
303 }
304
305 return 0;
306}
307
339 break;
340 }
341 }
342
343 return 0;
344}
345