initial commit
[freebsd-arm:freebsd-arm.git] / boot / ficl / testmain.c
1 /*
2 ** stub main for testing FICL under userland
3 ** $Id: testmain.c,v 1.13 2001/12/05 07:21:34 jsadler Exp $
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 */
39
40 /* $FreeBSD$ */
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>
49
50 #include "ficl.h"
51
52 /*
53 ** Ficl interface to getcwd
54 ** Prints the current working directory using the VM's 
55 ** textOut method...
56 */
57 static void ficlGetCWD(FICL_VM *pVM)
58 {
59     char *cp;
60
61     cp = getcwd(NULL, 80);
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
70 ** and feeds it to chdir()
71 ** Example:
72 **    cd c:\tmp
73 */
74 static void ficlChDir(FICL_VM *pVM)
75 {
76     FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
77     vmGetString(pVM, pFS, '\n');
78     if (pFS->count > 0)
79     {
80        int err = chdir(pFS->text);
81        if (err)
82         {
83             vmTextOut(pVM, "Error: path not found", 1);
84             vmThrow(pVM, VM_QUIT);
85         }
86     }
87     else
88     {
89         vmTextOut(pVM, "Warning (chdir): nothing happened", 1);
90     }
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:
99 **    system rm -rf /
100 **    \ ouch!
101 */
102 static 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)
108     {
109         int err = system(pFS->text);
110         if (err)
111         {
112             sprintf(pVM->pad, "System call returned %d", err);
113             vmTextOut(pVM, pVM->pad, 1);
114             vmThrow(pVM, VM_QUIT);
115         }
116     }
117     else
118     {
119         vmTextOut(pVM, "Warning (system): nothing happened", 1);
120     }
121     return;
122 }
123
124 /*
125 ** Ficl add-in to load a text file and execute it...
126 ** Cheesy, but illustrative.
127 ** Line oriented... filename is newline (or NULL) delimited.
128 ** Example:
129 **    load test.ficl
130 */
131 #define nLINEBUF 256
132 static void ficlLoad(FICL_VM *pVM)
133 {
134     char    cp[nLINEBUF];
135     char    filename[nLINEBUF];
136     FICL_STRING *pFilename = (FICL_STRING *)filename;
137     int     nLine = 0;
138     FILE   *fp;
139     int     result;
140     CELL    id;
141     struct stat buf;
142
143
144     vmGetString(pVM, pFilename, '\n');
145
146     if (pFilename->count <= 0)
147     {
148         vmTextOut(pVM, "Warning (load): nothing happened", 1);
149         return;
150     }
151
152     /*
153     ** get the file's size and make sure it exists 
154     */
155     result = stat( pFilename->text, &buf );
156
157     if (result != 0)
158     {
159         vmTextOut(pVM, "Unable to stat file: ", 0);
160         vmTextOut(pVM, pFilename->text, 1);
161         vmThrow(pVM, VM_QUIT);
162     }
163
164     fp = fopen(pFilename->text, "r");
165     if (!fp)
166     {
167         vmTextOut(pVM, "Unable to open file ", 0);
168         vmTextOut(pVM, pFilename->text, 1);
169         vmThrow(pVM, VM_QUIT);
170     }
171
172     id = pVM->sourceID;
173     pVM->sourceID.p = (void *)fp;
174
175     /* feed each line to ficlExec */
176     while (fgets(cp, nLINEBUF, fp))
177     {
178         int len = strlen(cp) - 1;
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         {
187                 pVM->sourceID = id;
188                 fclose(fp);
189                 vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);
190                 break; 
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);
206     return;
207 }
208
209 /*
210 ** Dump a tab delimited file that summarizes the contents of the
211 ** dictionary hash table by hashcode...
212 */
213 static void spewHash(FICL_VM *pVM)
214 {
215     FICL_HASH *pHash = vmGetDict(pVM)->pForthWords;
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
224     pOut = fopen(pVM->pad, "w");
225     if (!pOut)
226     {
227         vmTextOut(pVM, "unable to open file", 1);
228         return;
229     }
230
231     for (i=0; i < nHash; i++)
232     {
233         int n = 0;
234
235         pFW = pHash->table[i];
236         while (pFW)
237         {
238             n++;
239             pFW = pFW->link;
240         }
241
242         fprintf(pOut, "%d\t%d", i, n);
243
244         pFW = pHash->table[i];
245         while (pFW)
246         {
247             fprintf(pOut, "\t%s", pFW->name);
248             pFW = pFW->link;
249         }
250
251         fprintf(pOut, "\n");
252     }
253
254     fclose(pOut);
255     return;
256 }
257
258 static void ficlBreak(FICL_VM *pVM)
259 {
260     pVM->state = pVM->state;
261     return;
262 }
263
264 static void ficlClock(FICL_VM *pVM)
265 {
266     clock_t now = clock();
267     stackPushUNS(pVM->pStack, (FICL_UNS)now);
268     return;
269 }
270
271 static void clocksPerSec(FICL_VM *pVM)
272 {
273     stackPushUNS(pVM->pStack, CLOCKS_PER_SEC);
274     return;
275 }
276
277
278 static void execxt(FICL_VM *pVM)
279 {
280     FICL_WORD *pFW;
281 #if FICL_ROBUST > 1
282     vmCheckStack(pVM, 1, 0);
283 #endif
284
285     pFW = stackPopPtr(pVM->pStack);
286     ficlExecXT(pVM, pFW);
287
288     return;
289 }
290
291
292 void buildTestInterface(FICL_SYSTEM *pSys)
293 {
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);
304
305     return;
306 }
307
308
309 int main(int argc, char **argv)
310 {
311     char in[256];
312     FICL_VM *pVM;
313         FICL_SYSTEM *pSys;
314
315     pSys = ficlInitSystem(10000);
316     buildTestInterface(pSys);
317     pVM = ficlNewVM(pSys);
318
319     ficlEvaluate(pVM, ".ver .( " __DATE__ " ) cr quit");
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]);
327         ficlEvaluate(pVM, in);
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         {
338             ficlTermSystem(pSys);
339             break;
340         }
341     }
342
343     return 0;
344 }
345