testmain.c revision 40843
1/* 2** stub main for testing FICL under Win32 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> 14#ifdef linux 15#include <unistd.h> 16#endif 17 18#include "ficl.h" 19 20/* 21** Ficl interface to _getcwd (Win32) 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 29#ifdef WIN32 30 cp = _getcwd(NULL, 80); 31#else 32 cp = getcwd(NULL, 80); 33#endif 34 vmTextOut(pVM, cp, 1); 35 free(cp); 36 return; 37} 38 39/* 40** Ficl interface to _chdir (Win32) 41** Gets a newline (or NULL) delimited string from the input 42** and feeds it to the Win32 chdir function... 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 { 52#ifdef WIN32 53 int err = _chdir(pFS->text); 54#else 55 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 73** and feeds it to the Win32 system function... 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; 117#ifdef WIN32 118 struct _stat buf; 119#else 120 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 */ 135#ifdef WIN32 136 result = _stat( pFilename->text, &buf ); 137#else 138 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 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; 286 gets(in); 287 ret = ficlExec(pVM, in); 288 if (ret == VM_USEREXIT) 289 { 290 ficlTermSystem(); 291 break; 292 } 293 } 294 295 return 0; 296} 297 298#endif 299 300