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 /*
  41  * $FreeBSD: src/sys/boot/ficl/testmain.c,v 1.8 2002/04/09 17:45:11 dcs Exp $
  42  * $DragonFly: src/sys/boot/ficl/testmain.c,v 1.3 2003/11/10 06:08:33 dillon Exp $
  43  */
  44
  45 #include <stdlib.h>
  46 #include <stdio.h>
  47 #include <string.h>
  48 #include <time.h>
  49 #include <sys/types.h>
  50 #include <sys/stat.h>
  51 #include <unistd.h>
  52
  53 #include "ficl.h"
  54
  55 /*
  56 ** Ficl interface to getcwd
  57 ** Prints the current working directory using the VM's
  58 ** textOut method...
  59 */
  60 static void ficlGetCWD(FICL_VM *pVM)
  61 {
  62     char *cp;
  63
  64     cp = getcwd(NULL, 80);
  65     vmTextOut(pVM, cp, 1);
  66     free(cp);
  67     return;
  68 }
  69
  70 /*
  71 ** Ficl interface to chdir
  72 ** Gets a newline (or NULL) delimited string from the input
  73 ** and feeds it to chdir()
  74 ** Example:
  75 **    cd c:\tmp
  76 */
  77 static void ficlChDir(FICL_VM *pVM)
  78 {
  79     FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
  80     vmGetString(pVM, pFS, '\n');
  81     if (pFS->count > 0)
  82     {
  83        int err = chdir(pFS->text);
  84        if (err)
  85         {
  86             vmTextOut(pVM, "Error: path not found", 1);
  87             vmThrow(pVM, VM_QUIT);
  88         }
  89     }
  90     else
  91     {
  92         vmTextOut(pVM, "Warning (chdir): nothing happened", 1);
  93     }
  94     return;
  95 }
  96
  97 /*
  98 ** Ficl interface to system (ANSI)
  99 ** Gets a newline (or NULL) delimited string from the input
 100 ** and feeds it to system()
 101 ** Example:
 102 **    system rm -rf /
 103 **    \ ouch!
 104 */
 105 static void ficlSystem(FICL_VM *pVM)
 106 {
 107     FICL_STRING *pFS = (FICL_STRING *)pVM->pad;
 108
 109     vmGetString(pVM, pFS, '\n');
 110     if (pFS->count > 0)
 111     {
 112         int err = system(pFS->text);
 113         if (err)
 114         {
 115             sprintf(pVM->pad, "System call returned %d", err);
 116             vmTextOut(pVM, pVM->pad, 1);
 117             vmThrow(pVM, VM_QUIT);
 118         }
 119     }
 120     else
 121     {
 122         vmTextOut(pVM, "Warning (system): nothing happened", 1);
 123     }
 124     return;
 125 }
 126
 127 /*
 128 ** Ficl add-in to load a text file and execute it...
 129 ** Cheesy, but illustrative.
 130 ** Line oriented... filename is newline (or NULL) delimited.
 131 ** Example:
 132 **    load test.ficl
 133 */
 134 #define nLINEBUF 256
 135 static void ficlLoad(FICL_VM *pVM)
 136 {
 137     char    cp[nLINEBUF];
 138     char    filename[nLINEBUF];
 139     FICL_STRING *pFilename = (FICL_STRING *)filename;
 140     int     nLine = 0;
 141     FILE   *fp;
 142     int     result;
 143     CELL    id;
 144     struct stat buf;
 145
 146
 147     vmGetString(pVM, pFilename, '\n');
 148
 149     if (pFilename->count <= 0)
 150     {
 151         vmTextOut(pVM, "Warning (load): nothing happened", 1);
 152         return;
 153     }
 154
 155     /*
 156     ** get the file's size and make sure it exists
 157     */
 158     result = stat( pFilename->text, &buf );
 159
 160     if (result != 0)
 161     {
 162         vmTextOut(pVM, "Unable to stat file: ", 0);
 163         vmTextOut(pVM, pFilename->text, 1);
 164         vmThrow(pVM, VM_QUIT);
 165     }
 166
 167     fp = fopen(pFilename->text, "r");
 168     if (!fp)
 169     {
 170         vmTextOut(pVM, "Unable to open file ", 0);
 171         vmTextOut(pVM, pFilename->text, 1);
 172         vmThrow(pVM, VM_QUIT);
 173     }
 174
 175     id = pVM->sourceID;
 176     pVM->sourceID.p = (void *)fp;
 177
 178     /* feed each line to ficlExec */
 179     while (fgets(cp, nLINEBUF, fp))
 180     {
 181         int len = strlen(cp) - 1;
 182
 183         nLine++;
 184         if (len <= 0)
 185             continue;
 186
 187         result = ficlExecC(pVM, cp, len);
 188         if (result != VM_QUIT && result != VM_USEREXIT && result != VM_OUTOFTEXT )
 189         {
 190                 pVM->sourceID = id;
 191                 fclose(fp);
 192                 vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);
 193                 break;
 194         }
 195     }
 196     /*
 197     ** Pass an empty line with SOURCE-ID == -1 to flush
 198     ** any pending REFILLs (as required by FILE wordset)
 199     */
 200     pVM->sourceID.i = -1;
 201     ficlExec(pVM, "");
 202
 203     pVM->sourceID = id;
 204     fclose(fp);
 205
 206     /* handle "bye" in loaded files. --lch */
 207     if (result == VM_USEREXIT)
 208         vmThrow(pVM, VM_USEREXIT);
 209     return;
 210 }
 211
 212 /*
 213 ** Dump a tab delimited file that summarizes the contents of the
 214 ** dictionary hash table by hashcode...
 215 */
 216 static void spewHash(FICL_VM *pVM)
 217 {
 218     FICL_HASH *pHash = vmGetDict(pVM)->pForthWords;
 219     FICL_WORD *pFW;
 220     FILE *pOut;
 221     unsigned i;
 222     unsigned nHash = pHash->size;
 223
 224     if (!vmGetWordToPad(pVM))
 225         vmThrow(pVM, VM_OUTOFTEXT);
 226
 227     pOut = fopen(pVM->pad, "w");
 228     if (!pOut)
 229     {
 230         vmTextOut(pVM, "unable to open file", 1);
 231         return;
 232     }
 233
 234     for (i=0; i < nHash; i++)
 235     {
 236         int n = 0;
 237
 238         pFW = pHash->table[i];
 239         while (pFW)
 240         {
 241             n++;
 242             pFW = pFW->link;
 243         }
 244
 245         fprintf(pOut, "%d\t%d", i, n);
 246
 247         pFW = pHash->table[i];
 248         while (pFW)
 249         {
 250             fprintf(pOut, "\t%s", pFW->name);
 251             pFW = pFW->link;
 252         }
 253
 254         fprintf(pOut, "\n");
 255     }
 256
 257     fclose(pOut);
 258     return;
 259 }
 260
 261 static void ficlBreak(FICL_VM *pVM)
 262 {
 263     pVM->state = pVM->state;
 264     return;
 265 }
 266
 267 static void ficlClock(FICL_VM *pVM)
 268 {
 269     clock_t now = clock();
 270     stackPushUNS(pVM->pStack, (FICL_UNS)now);
 271     return;
 272 }
 273
 274 static void clocksPerSec(FICL_VM *pVM)
 275 {
 276     stackPushUNS(pVM->pStack, CLOCKS_PER_SEC);
 277     return;
 278 }
 279
 280
 281 static void execxt(FICL_VM *pVM)
 282 {
 283     FICL_WORD *pFW;
 284 #if FICL_ROBUST > 1
 285     vmCheckStack(pVM, 1, 0);
 286 #endif
 287
 288     pFW = stackPopPtr(pVM->pStack);
 289     ficlExecXT(pVM, pFW);
 290
 291     return;
 292 }
 293
 294
 295 void buildTestInterface(FICL_SYSTEM *pSys)
 296 {
 297     ficlBuild(pSys, "break",    ficlBreak,    FW_DEFAULT);
 298     ficlBuild(pSys, "clock",    ficlClock,    FW_DEFAULT);
 299     ficlBuild(pSys, "cd",       ficlChDir,    FW_DEFAULT);
 300     ficlBuild(pSys, "execxt",   execxt,       FW_DEFAULT);
 301     ficlBuild(pSys, "load",     ficlLoad,     FW_DEFAULT);
 302     ficlBuild(pSys, "pwd",      ficlGetCWD,   FW_DEFAULT);
 303     ficlBuild(pSys, "system",   ficlSystem,   FW_DEFAULT);
 304     ficlBuild(pSys, "spewhash", spewHash,     FW_DEFAULT);
 305     ficlBuild(pSys, "clocks/sec",
 306                                 clocksPerSec, FW_DEFAULT);
 307
 308     return;
 309 }
 310
 311
 312 int main(int argc, char **argv)
 313 {
 314     char in[256];
 315     FICL_VM *pVM;
 316         FICL_SYSTEM *pSys;
 317
 318     pSys = ficlInitSystem(10000);
 319     buildTestInterface(pSys);
 320     pVM = ficlNewVM(pSys);
 321
 322     ficlEvaluate(pVM, ".ver .( " __DATE__ " ) cr quit");
 323
 324     /*
 325     ** load file from cmd line...
 326     */
 327     if (argc  > 1)
 328     {
 329         sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
 330         ficlEvaluate(pVM, in);
 331     }
 332
 333     for (;;)
 334     {
 335         int ret;
 336         if (fgets(in, sizeof(in) - 1, stdin) == NULL)
 337             break;
 338         ret = ficlExec(pVM, in);
 339         if (ret == VM_USEREXIT)
 340         {
 341             ficlTermSystem(pSys);
 342             break;
 343         }
 344     }
 345
 346     return 0;
 347 }
 348