sys/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