testmain.c revision 53633 
1/*
2** stub main for testing FICL
3**
4*/
5
6/* $FreeBSD: head/sys/boot/ficl/testmain.c 53633 1999-11-23 11:17:37Z 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>
15
16#include "ficl.h"
17
18/*
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
27   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
36** and feeds it to chdir()
37** Example:
38**    cd c:\tmp
39*/
40static void ficlChDir(FICL_VM *pVM)
41{
42    FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
43    vmGetString(pVM, pFS, '\n');
44    if (pFS->count > 0)
45    {
46       int err = chdir(pFS->text);
47       if (err)
48        {
49            vmTextOut(pVM, "Error: path not found", 1);
50            vmThrow(pVM, VM_QUIT);
51        }
52    }
53    else
54    {
55        vmTextOut(pVM, "Warning (chdir): nothing happened", 1);
56    }
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:
65**    system del *.*
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)
74    {
75        int err = system(pFS->text);
76        if (err)
77        {
78            sprintf(pVM->pad, "System call returned %d", err);
79            vmTextOut(pVM, pVM->pad, 1);
80            vmThrow(pVM, VM_QUIT);
81        }
82    }
83    else
84    {
85        vmTextOut(pVM, "Warning (system): nothing happened", 1);
86    }
87    return;
88}
89
90/*
91** Ficl add-in to load a text file and execute it...
92** Cheesy, but illustrative.
93** Line oriented... filename is newline (or NULL) delimited.
94** Example:
95**    load test.ficl
96*/
97#define nLINEBUF 256
98static void ficlLoad(FICL_VM *pVM)
99{
100    char    cp[nLINEBUF];
101    char    filename[nLINEBUF];
102    FICL_STRING *pFilename = (FICL_STRING *)filename;
103    int     nLine = 0;
104    FILE   *fp;
105    int     result;
106    CELL    id;
107    struct stat buf;
108
109
110    vmGetString(pVM, pFilename, '\n');
111
112    if (pFilename->count <= 0)
113    {
114        vmTextOut(pVM, "Warning (load): nothing happened", 1);
115        return;
116    }
117
118    /*
119    ** get the file's size and make sure it exists
120    */
121    result = stat( pFilename->text, &buf );
122
123    if (result != 0)
124    {
125        vmTextOut(pVM, "Unable to stat file: ", 0);
126        vmTextOut(pVM, pFilename->text, 1);
127        vmThrow(pVM, VM_QUIT);
128    }
129
130    fp = fopen(pFilename->text, "r");
131    if (!fp)
132    {
133        vmTextOut(pVM, "Unable to open file ", 0);
134        vmTextOut(pVM, pFilename->text, 1);
135        vmThrow(pVM, VM_QUIT);
136    }
137
138    id = pVM->sourceID;
139    pVM->sourceID.p = (void *)fp;
140
141    /* feed each line to ficlExec */
142    while (fgets(cp, nLINEBUF, fp))
143    {
144        int len = strlen(cp) - 1;
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        {
153            pVM->sourceID = id;
154            fclose(fp);
155            vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);
156            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
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{
178    FICL_HASH *pHash = ficlGetDict()->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
187    pOut = fopen(pVM->pad, "w");
188    if (!pOut)
189    {
190        vmTextOut(pVM, "unable to open file", 1);
191        return;
192    }
193
194    for (i=0; i < nHash; i++)
195    {
196        int n = 0;
197
198        pFW = pHash->table[i];
199        while (pFW)
200        {
201            n++;
202            pFW = pFW->link;
203        }
204
205        fprintf(pOut, "%d\t%d", i, n);
206
207        pFW = pHash->table[i];
208        while (pFW)
209        {
210            fprintf(pOut, "\t%s", pFW->name);
211            pFW = pFW->link;
212        }
213
214        fprintf(pOut, "\n");
215    }
216
217    fclose(pOut);
218    return;
219}
220
221static void ficlBreak(FICL_VM *pVM)
222{
223    pVM->state = pVM->state;
224    return;
225}
226
227static void ficlClock(FICL_VM *pVM)
228{
229    clock_t now = clock();
230    stackPushUNS(pVM->pStack, (UNS32)now);
231    return;
232}
233
234static void clocksPerSec(FICL_VM *pVM)
235{
236    stackPushUNS(pVM->pStack, CLOCKS_PER_SEC);
237    return;
238}
239
240
241static void execxt(FICL_VM *pVM)
242{
243    FICL_WORD *pFW;
244#if FICL_ROBUST > 1
245    vmCheckStack(pVM, 1, 0);
246#endif
247
248    pFW = stackPopPtr(pVM->pStack);
249    ficlExecXT(pVM, pFW);
250
251    return;
252}
253
254
255void buildTestInterface(void)
256{
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);
267
268    return;
269}
270
271
272int main(int argc, char **argv)
273{
274    char in[256];
275    FICL_VM *pVM;
276
277    ficlInitSystem(10000);
278    buildTestInterface();
279    pVM = ficlNewVM();
280
281    ficlExec(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]);
289        ficlExec(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        {
300            ficlTermSystem();
301            break;
302        }
303    }
304
305    return 0;
306}
307
308