1/*
| 1/*
|
2** stub main for testing FICL under Win32
| 2** stub main for testing FICL
|
3**
4*/
5
6#include <stdlib.h>
7#include <stdio.h>
8#include <string.h>
| 3**
4*/
5
6#include <stdlib.h>
7#include <stdio.h>
8#include <string.h>
|
9#ifdef WIN32
10#include <direct.h>
11#endif
| |
12#include <sys/types.h>
13#include <sys/stat.h>
| 9#include <sys/types.h>
10#include <sys/stat.h>
|
14#ifdef linux
| |
15#include <unistd.h>
| 11#include <unistd.h>
|
16#endif
| |
17
18#include "ficl.h"
19
20/*
| 12
13#include "ficl.h"
14
15/*
|
21** Ficl interface to _getcwd (Win32)
| 16** Ficl interface to getcwd
|
22** Prints the current working directory using the VM's
23** textOut method...
24*/
25static void ficlGetCWD(FICL_VM *pVM)
26{
27 char *cp;
28
| 17** Prints the current working directory using the VM's
18** textOut method...
19*/
20static void ficlGetCWD(FICL_VM *pVM)
21{
22 char *cp;
23
|
29#ifdef WIN32
30 cp = _getcwd(NULL, 80);
31#else
| |
32 cp = getcwd(NULL, 80);
| 24 cp = getcwd(NULL, 80);
|
33#endif
| |
34 vmTextOut(pVM, cp, 1);
35 free(cp);
36 return;
37}
38
39/*
| 25 vmTextOut(pVM, cp, 1);
26 free(cp);
27 return;
28}
29
30/*
|
40** Ficl interface to _chdir (Win32)
| 31** Ficl interface to chdir
|
41** Gets a newline (or NULL) delimited string from the input
| 32** Gets a newline (or NULL) delimited string from the input
|
42** and feeds it to the Win32 chdir function...
| 33** and feeds it to chdir()
|
43** Example:
44** cd c:\tmp
45*/
46static void ficlChDir(FICL_VM *pVM)
47{
48 FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
49 vmGetString(pVM, pFS, '\n');
50 if (pFS->count > 0)
51 {
| 34** Example:
35** cd c:\tmp
36*/
37static void ficlChDir(FICL_VM *pVM)
38{
39 FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
40 vmGetString(pVM, pFS, '\n');
41 if (pFS->count > 0)
42 {
|
52#ifdef WIN32
53 int err = _chdir(pFS->text);
54#else
| |
55 int err = chdir(pFS->text);
| 43 int err = chdir(pFS->text);
|
56#endif
| |
57 if (err)
58 {
59 vmTextOut(pVM, "Error: path not found", 1);
60 vmThrow(pVM, VM_QUIT);
61 }
62 }
63 else
64 {
65 vmTextOut(pVM, "Warning (chdir): nothing happened", 1);
66 }
67 return;
68}
69
70/*
71** Ficl interface to system (ANSI)
72** Gets a newline (or NULL) delimited string from the input
| 44 if (err)
45 {
46 vmTextOut(pVM, "Error: path not found", 1);
47 vmThrow(pVM, VM_QUIT);
48 }
49 }
50 else
51 {
52 vmTextOut(pVM, "Warning (chdir): nothing happened", 1);
53 }
54 return;
55}
56
57/*
58** Ficl interface to system (ANSI)
59** Gets a newline (or NULL) delimited string from the input
|
73** and feeds it to the Win32 system function...
| 60** and feeds it to system()
|
74** Example:
75** system del *.*
76** \ ouch!
77*/
78static void ficlSystem(FICL_VM *pVM)
79{
80 FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
81
82 vmGetString(pVM, pFS, '\n');
83 if (pFS->count > 0)
84 {
85 int err = system(pFS->text);
86 if (err)
87 {
88 sprintf(pVM->pad, "System call returned %d", err);
89 vmTextOut(pVM, pVM->pad, 1);
90 vmThrow(pVM, VM_QUIT);
91 }
92 }
93 else
94 {
95 vmTextOut(pVM, "Warning (system): nothing happened", 1);
96 }
97 return;
98}
99
100/*
101** Ficl add-in to load a text file and execute it...
102** Cheesy, but illustrative.
103** Line oriented... filename is newline (or NULL) delimited.
104** Example:
105** load test.ficl
106*/
107#define nLINEBUF 256
108static void ficlLoad(FICL_VM *pVM)
109{
110 char cp[nLINEBUF];
111 char filename[nLINEBUF];
112 FICL_STRING *pFilename = (FICL_STRING *)filename;
113 int nLine = 0;
114 FILE *fp;
115 int result;
116 CELL id;
| 61** Example:
62** system del *.*
63** \ ouch!
64*/
65static void ficlSystem(FICL_VM *pVM)
66{
67 FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
68
69 vmGetString(pVM, pFS, '\n');
70 if (pFS->count > 0)
71 {
72 int err = system(pFS->text);
73 if (err)
74 {
75 sprintf(pVM->pad, "System call returned %d", err);
76 vmTextOut(pVM, pVM->pad, 1);
77 vmThrow(pVM, VM_QUIT);
78 }
79 }
80 else
81 {
82 vmTextOut(pVM, "Warning (system): nothing happened", 1);
83 }
84 return;
85}
86
87/*
88** Ficl add-in to load a text file and execute it...
89** Cheesy, but illustrative.
90** Line oriented... filename is newline (or NULL) delimited.
91** Example:
92** load test.ficl
93*/
94#define nLINEBUF 256
95static void ficlLoad(FICL_VM *pVM)
96{
97 char cp[nLINEBUF];
98 char filename[nLINEBUF];
99 FICL_STRING *pFilename = (FICL_STRING *)filename;
100 int nLine = 0;
101 FILE *fp;
102 int result;
103 CELL id;
|
117#ifdef WIN32
118 struct _stat buf;
119#else
| |
120 struct stat buf;
| 104 struct stat buf;
|
121#endif
| |
122
123
124 vmGetString(pVM, pFilename, '\n');
125
126 if (pFilename->count <= 0)
127 {
128 vmTextOut(pVM, "Warning (load): nothing happened", 1);
129 return;
130 }
131
132 /*
133 ** get the file's size and make sure it exists
134 */
| 105
106
107 vmGetString(pVM, pFilename, '\n');
108
109 if (pFilename->count <= 0)
110 {
111 vmTextOut(pVM, "Warning (load): nothing happened", 1);
112 return;
113 }
114
115 /*
116 ** get the file's size and make sure it exists
117 */
|
135#ifdef WIN32
136 result = _stat( pFilename->text, &buf );
137#else
| |
138 result = stat( pFilename->text, &buf );
| 118 result = stat( pFilename->text, &buf );
|
139#endif
| |
140
141 if (result != 0)
142 {
143 vmTextOut(pVM, "Unable to stat file: ", 0);
144 vmTextOut(pVM, pFilename->text, 1);
145 vmThrow(pVM, VM_QUIT);
146 }
147
148 fp = fopen(pFilename->text, "r");
149 if (!fp)
150 {
151 vmTextOut(pVM, "Unable to open file ", 0);
152 vmTextOut(pVM, pFilename->text, 1);
153 vmThrow(pVM, VM_QUIT);
154 }
155
156 id = pVM->sourceID;
157 pVM->sourceID.p = (void *)fp;
158
159 /* feed each line to ficlExec */
160 while (fgets(cp, nLINEBUF, fp))
161 {
162 int len = strlen(cp) - 1;
163
164 nLine++;
165 if (len <= 0)
166 continue;
167
168 if (cp[len] == '\n')
169 cp[len] = '\0';
170
171 result = ficlExec(pVM, cp);
172 if (result >= VM_ERREXIT)
173 {
174 pVM->sourceID = id;
175 fclose(fp);
176 vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);
177 break;
178 }
179 }
180 /*
181 ** Pass an empty line with SOURCE-ID == 0 to flush
182 ** any pending REFILLs (as required by FILE wordset)
183 */
184 pVM->sourceID.i = -1;
185 ficlExec(pVM, "");
186
187 pVM->sourceID = id;
188 fclose(fp);
189
190 return;
191}
192
193/*
194** Dump a tab delimited file that summarizes the contents of the
195** dictionary hash table by hashcode...
196*/
197static void spewHash(FICL_VM *pVM)
198{
199 FICL_HASH *pHash = ficlGetDict()->pForthWords;
200 FICL_WORD *pFW;
201 FILE *pOut;
202 unsigned i;
203 unsigned nHash = pHash->size;
204
205 if (!vmGetWordToPad(pVM))
206 vmThrow(pVM, VM_OUTOFTEXT);
207
208 pOut = fopen(pVM->pad, "w");
209 if (!pOut)
210 {
211 vmTextOut(pVM, "unable to open file", 1);
212 return;
213 }
214
215 for (i=0; i < nHash; i++)
216 {
217 int n = 0;
218
219 pFW = pHash->table[i];
220 while (pFW)
221 {
222 n++;
223 pFW = pFW->link;
224 }
225
226 fprintf(pOut, "%d\t%d", i, n);
227
228 pFW = pHash->table[i];
229 while (pFW)
230 {
231 fprintf(pOut, "\t%s", pFW->name);
232 pFW = pFW->link;
233 }
234
235 fprintf(pOut, "\n");
236 }
237
238 fclose(pOut);
239 return;
240}
241
242static void ficlBreak(FICL_VM *pVM)
243{
244 pVM->state = pVM->state;
245 return;
246}
247
248void buildTestInterface(void)
249{
250 ficlBuild("break", ficlBreak, FW_DEFAULT);
251 ficlBuild("cd", ficlChDir, FW_DEFAULT);
252 ficlBuild("load", ficlLoad, FW_DEFAULT);
253 ficlBuild("pwd", ficlGetCWD, FW_DEFAULT);
254 ficlBuild("system", ficlSystem, FW_DEFAULT);
255 ficlBuild("spewhash", spewHash, FW_DEFAULT);
256
257 return;
258}
259
260
| 119
120 if (result != 0)
121 {
122 vmTextOut(pVM, "Unable to stat file: ", 0);
123 vmTextOut(pVM, pFilename->text, 1);
124 vmThrow(pVM, VM_QUIT);
125 }
126
127 fp = fopen(pFilename->text, "r");
128 if (!fp)
129 {
130 vmTextOut(pVM, "Unable to open file ", 0);
131 vmTextOut(pVM, pFilename->text, 1);
132 vmThrow(pVM, VM_QUIT);
133 }
134
135 id = pVM->sourceID;
136 pVM->sourceID.p = (void *)fp;
137
138 /* feed each line to ficlExec */
139 while (fgets(cp, nLINEBUF, fp))
140 {
141 int len = strlen(cp) - 1;
142
143 nLine++;
144 if (len <= 0)
145 continue;
146
147 if (cp[len] == '\n')
148 cp[len] = '\0';
149
150 result = ficlExec(pVM, cp);
151 if (result >= VM_ERREXIT)
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 == 0 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
227void buildTestInterface(void)
228{
229 ficlBuild("break", ficlBreak, FW_DEFAULT);
230 ficlBuild("cd", ficlChDir, FW_DEFAULT);
231 ficlBuild("load", ficlLoad, FW_DEFAULT);
232 ficlBuild("pwd", ficlGetCWD, FW_DEFAULT);
233 ficlBuild("system", ficlSystem, FW_DEFAULT);
234 ficlBuild("spewhash", spewHash, FW_DEFAULT);
235
236 return;
237}
238
239
|
261#if !defined (_WINDOWS)
262
| |
263int main(int argc, char **argv)
264{
265 char in[256];
266 FICL_VM *pVM;
267
268 ficlInitSystem(10000);
269 buildTestInterface();
270 pVM = ficlNewVM();
271
272 ficlExec(pVM, ".ver .( " __DATE__ " ) cr quit");
273
274 /*
275 ** load file from cmd line...
276 */
277 if (argc > 1)
278 {
279 sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
280 ficlExec(pVM, in);
281 }
282
283 for (;;)
284 {
285 int ret;
| 240int main(int argc, char **argv)
241{
242 char in[256];
243 FICL_VM *pVM;
244
245 ficlInitSystem(10000);
246 buildTestInterface();
247 pVM = ficlNewVM();
248
249 ficlExec(pVM, ".ver .( " __DATE__ " ) cr quit");
250
251 /*
252 ** load file from cmd line...
253 */
254 if (argc > 1)
255 {
256 sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
257 ficlExec(pVM, in);
258 }
259
260 for (;;)
261 {
262 int ret;
|
286 gets(in);
| 263 if (fgets(in, sizeof(in) - 1, stdin) == NULL)
264 break;
|
287 ret = ficlExec(pVM, in);
288 if (ret == VM_USEREXIT)
289 {
290 ficlTermSystem();
291 break;
292 }
293 }
294
295 return 0;
296}
297
| 265 ret = ficlExec(pVM, in);
266 if (ret == VM_USEREXIT)
267 {
268 ficlTermSystem();
269 break;
270 }
271 }
272
273 return 0;
274}
275
|
298#endif
299
| |
| |