140843Smsmith/* 294290Sdcs** stub main for testing FICL under userland 394290Sdcs** $Id: testmain.c,v 1.13 2001/12/05 07:21:34 jsadler Exp $ 440843Smsmith*/ 594290Sdcs/* 694290Sdcs** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) 794290Sdcs** All rights reserved. 894290Sdcs** 994290Sdcs** Get the latest Ficl release at http://ficl.sourceforge.net 1094290Sdcs** 1194290Sdcs** I am interested in hearing from anyone who uses ficl. If you have 1294290Sdcs** a problem, a success story, a defect, an enhancement request, or 1394290Sdcs** if you would like to contribute to the ficl release, please 1494290Sdcs** contact me by email at the address above. 1594290Sdcs** 1694290Sdcs** L I C E N S E and D I S C L A I M E R 1794290Sdcs** 1894290Sdcs** Redistribution and use in source and binary forms, with or without 1994290Sdcs** modification, are permitted provided that the following conditions 2094290Sdcs** are met: 2194290Sdcs** 1. Redistributions of source code must retain the above copyright 2294290Sdcs** notice, this list of conditions and the following disclaimer. 2394290Sdcs** 2. Redistributions in binary form must reproduce the above copyright 2494290Sdcs** notice, this list of conditions and the following disclaimer in the 2594290Sdcs** documentation and/or other materials provided with the distribution. 2694290Sdcs** 2794290Sdcs** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 2894290Sdcs** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 2994290Sdcs** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 3094290Sdcs** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 3194290Sdcs** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 3294290Sdcs** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 3394290Sdcs** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 3494290Sdcs** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 3594290Sdcs** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 3694290Sdcs** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 3794290Sdcs** SUCH DAMAGE. 3894290Sdcs*/ 3940843Smsmith 4051786Sdcs/* $FreeBSD: stable/11/stand/ficl/testmain.c 94290 2002-04-09 17:45:28Z dcs $ */ 4151786Sdcs 4240843Smsmith#include <stdlib.h> 4340843Smsmith#include <stdio.h> 4440843Smsmith#include <string.h> 4551786Sdcs#include <time.h> 4640843Smsmith#include <sys/types.h> 4740843Smsmith#include <sys/stat.h> 4840843Smsmith#include <unistd.h> 4940843Smsmith 5040843Smsmith#include "ficl.h" 5140843Smsmith 5240843Smsmith/* 5340883Smsmith** Ficl interface to getcwd 5440843Smsmith** Prints the current working directory using the VM's 5540843Smsmith** textOut method... 5640843Smsmith*/ 5740843Smsmithstatic void ficlGetCWD(FICL_VM *pVM) 5840843Smsmith{ 5940843Smsmith char *cp; 6040843Smsmith 6194290Sdcs cp = getcwd(NULL, 80); 6240843Smsmith vmTextOut(pVM, cp, 1); 6340843Smsmith free(cp); 6440843Smsmith return; 6540843Smsmith} 6640843Smsmith 6740843Smsmith/* 6840883Smsmith** Ficl interface to chdir 6940843Smsmith** Gets a newline (or NULL) delimited string from the input 7040883Smsmith** and feeds it to chdir() 7140843Smsmith** Example: 7240843Smsmith** cd c:\tmp 7340843Smsmith*/ 7440843Smsmithstatic void ficlChDir(FICL_VM *pVM) 7540843Smsmith{ 7640843Smsmith FICL_STRING *pFS = (FICL_STRING *)pVM->pad; 7740843Smsmith vmGetString(pVM, pFS, '\n'); 7840843Smsmith if (pFS->count > 0) 7940843Smsmith { 8040843Smsmith int err = chdir(pFS->text); 8140843Smsmith if (err) 8240843Smsmith { 8340843Smsmith vmTextOut(pVM, "Error: path not found", 1); 8440843Smsmith vmThrow(pVM, VM_QUIT); 8540843Smsmith } 8640843Smsmith } 8740843Smsmith else 8840843Smsmith { 8940843Smsmith vmTextOut(pVM, "Warning (chdir): nothing happened", 1); 9040843Smsmith } 9140843Smsmith return; 9240843Smsmith} 9340843Smsmith 9440843Smsmith/* 9540843Smsmith** Ficl interface to system (ANSI) 9640843Smsmith** Gets a newline (or NULL) delimited string from the input 9740883Smsmith** and feeds it to system() 9840843Smsmith** Example: 9994290Sdcs** system rm -rf / 10040843Smsmith** \ ouch! 10140843Smsmith*/ 10240843Smsmithstatic void ficlSystem(FICL_VM *pVM) 10340843Smsmith{ 10440843Smsmith FICL_STRING *pFS = (FICL_STRING *)pVM->pad; 10540843Smsmith 10640843Smsmith vmGetString(pVM, pFS, '\n'); 10740843Smsmith if (pFS->count > 0) 10840843Smsmith { 10940843Smsmith int err = system(pFS->text); 11040843Smsmith if (err) 11140843Smsmith { 11240843Smsmith sprintf(pVM->pad, "System call returned %d", err); 11340843Smsmith vmTextOut(pVM, pVM->pad, 1); 11440843Smsmith vmThrow(pVM, VM_QUIT); 11540843Smsmith } 11640843Smsmith } 11740843Smsmith else 11840843Smsmith { 11940843Smsmith vmTextOut(pVM, "Warning (system): nothing happened", 1); 12040843Smsmith } 12140843Smsmith return; 12240843Smsmith} 12340843Smsmith 12440843Smsmith/* 12540843Smsmith** Ficl add-in to load a text file and execute it... 12640843Smsmith** Cheesy, but illustrative. 12740843Smsmith** Line oriented... filename is newline (or NULL) delimited. 12840843Smsmith** Example: 12940843Smsmith** load test.ficl 13040843Smsmith*/ 13140843Smsmith#define nLINEBUF 256 13240843Smsmithstatic void ficlLoad(FICL_VM *pVM) 13340843Smsmith{ 13440843Smsmith char cp[nLINEBUF]; 13540843Smsmith char filename[nLINEBUF]; 13640843Smsmith FICL_STRING *pFilename = (FICL_STRING *)filename; 13740843Smsmith int nLine = 0; 13840843Smsmith FILE *fp; 13940843Smsmith int result; 14040843Smsmith CELL id; 14140843Smsmith struct stat buf; 14240843Smsmith 14340843Smsmith 14440843Smsmith vmGetString(pVM, pFilename, '\n'); 14540843Smsmith 14640843Smsmith if (pFilename->count <= 0) 14740843Smsmith { 14840843Smsmith vmTextOut(pVM, "Warning (load): nothing happened", 1); 14940843Smsmith return; 15040843Smsmith } 15140843Smsmith 15240843Smsmith /* 15340843Smsmith ** get the file's size and make sure it exists 15440843Smsmith */ 15540843Smsmith result = stat( pFilename->text, &buf ); 15640843Smsmith 15740843Smsmith if (result != 0) 15840843Smsmith { 15940843Smsmith vmTextOut(pVM, "Unable to stat file: ", 0); 16040843Smsmith vmTextOut(pVM, pFilename->text, 1); 16140843Smsmith vmThrow(pVM, VM_QUIT); 16240843Smsmith } 16340843Smsmith 16440843Smsmith fp = fopen(pFilename->text, "r"); 16540843Smsmith if (!fp) 16640843Smsmith { 16740843Smsmith vmTextOut(pVM, "Unable to open file ", 0); 16840843Smsmith vmTextOut(pVM, pFilename->text, 1); 16940843Smsmith vmThrow(pVM, VM_QUIT); 17040843Smsmith } 17140843Smsmith 17240843Smsmith id = pVM->sourceID; 17340843Smsmith pVM->sourceID.p = (void *)fp; 17440843Smsmith 17540843Smsmith /* feed each line to ficlExec */ 17640843Smsmith while (fgets(cp, nLINEBUF, fp)) 17740843Smsmith { 17840843Smsmith int len = strlen(cp) - 1; 17940843Smsmith 18040843Smsmith nLine++; 18140843Smsmith if (len <= 0) 18240843Smsmith continue; 18340843Smsmith 18451786Sdcs result = ficlExecC(pVM, cp, len); 18543078Smsmith if (result != VM_QUIT && result != VM_USEREXIT && result != VM_OUTOFTEXT ) 18640843Smsmith { 18794290Sdcs pVM->sourceID = id; 18894290Sdcs fclose(fp); 18994290Sdcs vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine); 19094290Sdcs break; 19140843Smsmith } 19240843Smsmith } 19340843Smsmith /* 19451786Sdcs ** Pass an empty line with SOURCE-ID == -1 to flush 19540843Smsmith ** any pending REFILLs (as required by FILE wordset) 19640843Smsmith */ 19740843Smsmith pVM->sourceID.i = -1; 19853633Sdcs ficlExec(pVM, ""); 19940843Smsmith 20040843Smsmith pVM->sourceID = id; 20140843Smsmith fclose(fp); 20240843Smsmith 20394290Sdcs /* handle "bye" in loaded files. --lch */ 20494290Sdcs if (result == VM_USEREXIT) 20594290Sdcs vmThrow(pVM, VM_USEREXIT); 20640843Smsmith return; 20740843Smsmith} 20840843Smsmith 20940843Smsmith/* 21040843Smsmith** Dump a tab delimited file that summarizes the contents of the 21140843Smsmith** dictionary hash table by hashcode... 21240843Smsmith*/ 21340843Smsmithstatic void spewHash(FICL_VM *pVM) 21440843Smsmith{ 21594290Sdcs FICL_HASH *pHash = vmGetDict(pVM)->pForthWords; 21640843Smsmith FICL_WORD *pFW; 21740843Smsmith FILE *pOut; 21840843Smsmith unsigned i; 21940843Smsmith unsigned nHash = pHash->size; 22040843Smsmith 22140843Smsmith if (!vmGetWordToPad(pVM)) 22240843Smsmith vmThrow(pVM, VM_OUTOFTEXT); 22340843Smsmith 22440843Smsmith pOut = fopen(pVM->pad, "w"); 22540843Smsmith if (!pOut) 22640843Smsmith { 22740843Smsmith vmTextOut(pVM, "unable to open file", 1); 22840843Smsmith return; 22940843Smsmith } 23040843Smsmith 23140843Smsmith for (i=0; i < nHash; i++) 23240843Smsmith { 23340843Smsmith int n = 0; 23440843Smsmith 23540843Smsmith pFW = pHash->table[i]; 23640843Smsmith while (pFW) 23740843Smsmith { 23840843Smsmith n++; 23940843Smsmith pFW = pFW->link; 24040843Smsmith } 24140843Smsmith 24240843Smsmith fprintf(pOut, "%d\t%d", i, n); 24340843Smsmith 24440843Smsmith pFW = pHash->table[i]; 24540843Smsmith while (pFW) 24640843Smsmith { 24740843Smsmith fprintf(pOut, "\t%s", pFW->name); 24840843Smsmith pFW = pFW->link; 24940843Smsmith } 25040843Smsmith 25140843Smsmith fprintf(pOut, "\n"); 25240843Smsmith } 25340843Smsmith 25440843Smsmith fclose(pOut); 25540843Smsmith return; 25640843Smsmith} 25740843Smsmith 25840843Smsmithstatic void ficlBreak(FICL_VM *pVM) 25940843Smsmith{ 26040843Smsmith pVM->state = pVM->state; 26140843Smsmith return; 26240843Smsmith} 26340843Smsmith 26451786Sdcsstatic void ficlClock(FICL_VM *pVM) 26551786Sdcs{ 26651786Sdcs clock_t now = clock(); 26761182Sdcs stackPushUNS(pVM->pStack, (FICL_UNS)now); 26851786Sdcs return; 26951786Sdcs} 27051786Sdcs 27151786Sdcsstatic void clocksPerSec(FICL_VM *pVM) 27251786Sdcs{ 27351786Sdcs stackPushUNS(pVM->pStack, CLOCKS_PER_SEC); 27451786Sdcs return; 27551786Sdcs} 27651786Sdcs 27751786Sdcs 27851786Sdcsstatic void execxt(FICL_VM *pVM) 27951786Sdcs{ 28051786Sdcs FICL_WORD *pFW; 28151786Sdcs#if FICL_ROBUST > 1 28251786Sdcs vmCheckStack(pVM, 1, 0); 28351786Sdcs#endif 28451786Sdcs 28551786Sdcs pFW = stackPopPtr(pVM->pStack); 28651786Sdcs ficlExecXT(pVM, pFW); 28751786Sdcs 28851786Sdcs return; 28951786Sdcs} 29051786Sdcs 29151786Sdcs 29294290Sdcsvoid buildTestInterface(FICL_SYSTEM *pSys) 29340843Smsmith{ 29494290Sdcs ficlBuild(pSys, "break", ficlBreak, FW_DEFAULT); 29594290Sdcs ficlBuild(pSys, "clock", ficlClock, FW_DEFAULT); 29694290Sdcs ficlBuild(pSys, "cd", ficlChDir, FW_DEFAULT); 29794290Sdcs ficlBuild(pSys, "execxt", execxt, FW_DEFAULT); 29894290Sdcs ficlBuild(pSys, "load", ficlLoad, FW_DEFAULT); 29994290Sdcs ficlBuild(pSys, "pwd", ficlGetCWD, FW_DEFAULT); 30094290Sdcs ficlBuild(pSys, "system", ficlSystem, FW_DEFAULT); 30194290Sdcs ficlBuild(pSys, "spewhash", spewHash, FW_DEFAULT); 30294290Sdcs ficlBuild(pSys, "clocks/sec", 30394290Sdcs clocksPerSec, FW_DEFAULT); 30440843Smsmith 30540843Smsmith return; 30640843Smsmith} 30740843Smsmith 30840843Smsmith 30940843Smsmithint main(int argc, char **argv) 31040843Smsmith{ 31153633Sdcs char in[256]; 31240843Smsmith FICL_VM *pVM; 31394290Sdcs FICL_SYSTEM *pSys; 31440843Smsmith 31594290Sdcs pSys = ficlInitSystem(10000); 31694290Sdcs buildTestInterface(pSys); 31794290Sdcs pVM = ficlNewVM(pSys); 31840843Smsmith 31994290Sdcs ficlEvaluate(pVM, ".ver .( " __DATE__ " ) cr quit"); 32040843Smsmith 32140843Smsmith /* 32240843Smsmith ** load file from cmd line... 32340843Smsmith */ 32440843Smsmith if (argc > 1) 32540843Smsmith { 32640843Smsmith sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]); 32794290Sdcs ficlEvaluate(pVM, in); 32840843Smsmith } 32940843Smsmith 33040843Smsmith for (;;) 33140843Smsmith { 33240843Smsmith int ret; 33340883Smsmith if (fgets(in, sizeof(in) - 1, stdin) == NULL) 33440883Smsmith break; 33553633Sdcs ret = ficlExec(pVM, in); 33640843Smsmith if (ret == VM_USEREXIT) 33740843Smsmith { 33894290Sdcs ficlTermSystem(pSys); 33940843Smsmith break; 34040843Smsmith } 34140843Smsmith } 34240843Smsmith 34340843Smsmith return 0; 34440843Smsmith} 34540843Smsmith 346