-/*\r
-** stub main for testing FICL under Win32\r
-** \r
-*/\r
-\r
-#include <stdlib.h>\r
-#include <stdio.h>\r
-#include <string.h>\r
-#include <time.h>\r
-#include <sys/types.h>\r
-#include <sys/stat.h>\r
-#ifdef linux\r
-#include <unistd.h>\r
-#endif\r
-\r
-#include "ficl.h"\r
-\r
-/*\r
-** Ficl interface to _getcwd (Win32)\r
-** Prints the current working directory using the VM's \r
-** textOut method...\r
-*/\r
-static void ficlGetCWD(FICL_VM *pVM)\r
-{\r
- char *cp;\r
-\r
- cp = getcwd(NULL, 80);\r
- vmTextOut(pVM, cp, 1);\r
- free(cp);\r
- return;\r
-}\r
-\r
-/*\r
-** Ficl interface to _chdir (Win32)\r
-** Gets a newline (or NULL) delimited string from the input\r
-** and feeds it to the Win32 chdir function...\r
-** Example:\r
-** cd c:\tmp\r
-*/\r
-static void ficlChDir(FICL_VM *pVM)\r
-{\r
- FICL_STRING *pFS = (FICL_STRING *)pVM->pad;\r
- vmGetString(pVM, pFS, '\n');\r
- if (pFS->count > 0)\r
- {\r
- int err = chdir(pFS->text);\r
- if (err)\r
- {\r
- vmTextOut(pVM, "Error: path not found", 1);\r
- vmThrow(pVM, VM_QUIT);\r
- }\r
- }\r
- else\r
- {\r
- vmTextOut(pVM, "Warning (chdir): nothing happened", 1);\r
- }\r
- return;\r
-}\r
-\r
-/*\r
-** Ficl interface to system (ANSI)\r
-** Gets a newline (or NULL) delimited string from the input\r
-** and feeds it to the Win32 system function...\r
-** Example:\r
-** system del *.*\r
-** \ ouch!\r
-*/\r
-static void ficlSystem(FICL_VM *pVM)\r
-{\r
- FICL_STRING *pFS = (FICL_STRING *)pVM->pad;\r
-\r
- vmGetString(pVM, pFS, '\n');\r
- if (pFS->count > 0)\r
- {\r
- int err = system(pFS->text);\r
- if (err)\r
- {\r
- sprintf(pVM->pad, "System call returned %d", err);\r
- vmTextOut(pVM, pVM->pad, 1);\r
- vmThrow(pVM, VM_QUIT);\r
- }\r
- }\r
- else\r
- {\r
- vmTextOut(pVM, "Warning (system): nothing happened", 1);\r
- }\r
- return;\r
-}\r
-\r
-/*\r
-** Ficl add-in to load a text file and execute it...\r
-** Cheesy, but illustrative.\r
-** Line oriented... filename is newline (or NULL) delimited.\r
-** Example:\r
-** load test.ficl\r
-*/\r
-#define nLINEBUF 256\r
-static void ficlLoad(FICL_VM *pVM)\r
-{\r
- char cp[nLINEBUF];\r
- char filename[nLINEBUF];\r
- FICL_STRING *pFilename = (FICL_STRING *)filename;\r
- int nLine = 0;\r
- FILE *fp;\r
- int result;\r
- CELL id;\r
- struct stat buf;\r
-\r
- vmGetString(pVM, pFilename, '\n');\r
-\r
- if (pFilename->count <= 0)\r
- {\r
- vmTextOut(pVM, "Warning (load): nothing happened", 1);\r
- return;\r
- }\r
-\r
- /*\r
- ** get the file's size and make sure it exists \r
- */\r
- result = stat( pFilename->text, &buf );\r
-\r
- if (result != 0)\r
- {\r
- vmTextOut(pVM, "Unable to stat file: ", 0);\r
- vmTextOut(pVM, pFilename->text, 1);\r
- vmThrow(pVM, VM_QUIT);\r
- }\r
-\r
- fp = fopen(pFilename->text, "r");\r
- if (!fp)\r
- {\r
- vmTextOut(pVM, "Unable to open file ", 0);\r
- vmTextOut(pVM, pFilename->text, 1);\r
- vmThrow(pVM, VM_QUIT);\r
- }\r
-\r
- id = pVM->sourceID;\r
- pVM->sourceID.p = (void *)fp;\r
-\r
- /* feed each line to ficlExec */\r
- while (fgets(cp, nLINEBUF, fp))\r
- {\r
- int len = strlen(cp) - 1;\r
-\r
- nLine++;\r
- if (len <= 0)\r
- continue;\r
-\r
- if (cp[len] == '\n')\r
- cp[len] = '\0';\r
-\r
- result = ficlExec(pVM, cp);\r
- if (result != VM_OUTOFTEXT)\r
- {\r
- pVM->sourceID = id;\r
- fclose(fp);\r
- vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine);\r
- break; \r
- }\r
- }\r
- /*\r
- ** Pass an empty line with SOURCE-ID == -1 to flush\r
- ** any pending REFILLs (as required by FILE wordset)\r
- */\r
- pVM->sourceID.i = -1;\r
- ficlExec(pVM, "");\r
-\r
- pVM->sourceID = id;\r
- fclose(fp);\r
-\r
- return;\r
-}\r
-\r
-/*\r
-** Dump a tab delimited file that summarizes the contents of the\r
-** dictionary hash table by hashcode...\r
-*/\r
-static void spewHash(FICL_VM *pVM)\r
-{\r
- FICL_HASH *pHash = ficlGetDict()->pForthWords;\r
- FICL_WORD *pFW;\r
- FILE *pOut;\r
- unsigned i;\r
- unsigned nHash = pHash->size;\r
-\r
- if (!vmGetWordToPad(pVM))\r
- vmThrow(pVM, VM_OUTOFTEXT);\r
-\r
- pOut = fopen(pVM->pad, "w");\r
- if (!pOut)\r
- {\r
- vmTextOut(pVM, "unable to open file", 1);\r
- return;\r
- }\r
-\r
- for (i=0; i < nHash; i++)\r
- {\r
- int n = 0;\r
-\r
- pFW = pHash->table[i];\r
- while (pFW)\r
- {\r
- n++;\r
- pFW = pFW->link;\r
- }\r
-\r
- fprintf(pOut, "%d\t%d", i, n);\r
-\r
- pFW = pHash->table[i];\r
- while (pFW)\r
- {\r
- fprintf(pOut, "\t%s", pFW->name);\r
- pFW = pFW->link;\r
- }\r
-\r
- fprintf(pOut, "\n");\r
- }\r
-\r
- fclose(pOut);\r
- return;\r
-}\r
-\r
-static void ficlBreak(FICL_VM *pVM)\r
-{\r
- pVM->state = pVM->state;\r
- return;\r
-}\r
-\r
-static void ficlClock(FICL_VM *pVM)\r
-{\r
- clock_t now = clock();\r
- stackPushUNS(pVM->pStack, (UNS32)now);\r
- return;\r
-}\r
-\r
-static void clocksPerSec(FICL_VM *pVM)\r
-{\r
- stackPushUNS(pVM->pStack, CLOCKS_PER_SEC);\r
- return;\r
-}\r
-\r
-\r
-static void execxt(FICL_VM *pVM)\r
-{\r
- FICL_WORD *pFW;\r
-#if FICL_ROBUST > 1\r
- vmCheckStack(pVM, 1, 0);\r
-#endif\r
-\r
- pFW = stackPopPtr(pVM->pStack);\r
- ficlExecXT(pVM, pFW);\r
-\r
- return;\r
-}\r
-\r
-\r
-static void buildTestInterface(void)\r
-{\r
- ficlBuild("break", ficlBreak, FW_DEFAULT);\r
- ficlBuild("clock", ficlClock, FW_DEFAULT);\r
- ficlBuild("cd", ficlChDir, FW_DEFAULT);\r
- ficlBuild("execxt", execxt, FW_DEFAULT);\r
- ficlBuild("load", ficlLoad, FW_DEFAULT);\r
- ficlBuild("pwd", ficlGetCWD, FW_DEFAULT);\r
- ficlBuild("system", ficlSystem, FW_DEFAULT);\r
- ficlBuild("spewhash", spewHash, FW_DEFAULT);\r
- ficlBuild("clocks/sec", \r
- clocksPerSec, FW_DEFAULT);\r
-\r
- return;\r
-}\r
-\r
-\r
-static int quiet = 0;\r
-\r
-int main(int argc, char **argv)\r
-{\r
- char in[BUFSIZ], * s;\r
- FICL_VM *pVM;\r
- extern char * optarg;\r
- extern int optind, opterr, optopt;\r
- int errflg = 0;\r
- int ret;\r
- int c;\r
-\r
- while ((c = getopt(argc, argv, "q")) != EOF)\r
- switch (c) {\r
- case 'q':\r
- quiet++;\r
- break;\r
- case '?':\r
- default:\r
- errflg++;\r
- break;\r
- }\r
-\r
- ficlInitSystem(10000);\r
- buildTestInterface();\r
- pVM = ficlNewVM();\r
-\r
- if (!quiet)\r
- ficlExec(pVM, ".ver .( " __DATE__ " ) cr quit");\r
-\r
- for ( ; optind < argc; optind++) {\r
- sprintf(in, ".( loading %s ) cr load %s\n cr", argv[optind], argv[optind]);\r
- ficlExec(pVM, in);\r
- }\r
-\r
- s = in;\r
- if (!quiet)\r
- *s++ = '\n';\r
- *s++ = '\0';\r
- ret = 0;\r
- do {\r
- if (in[0])\r
- ret = ficlExec(pVM, in);\r
- } while (ret != VM_USEREXIT && (s = fgets(in, sizeof(in)-1, stdin)) != NULL);\r
-\r
- ficlTermSystem();\r
-\r
- return 0;\r
-}\r
+/*
+** stub main for testing Ficl
+** $Id: tficl.c,v 1.3 2003/06/26 18:19:26 jbj Exp $
+*/
+/*
+** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
+** All rights reserved.
+**
+** Get the latest Ficl release at http://ficl.sourceforge.net
+**
+** I am interested in hearing from anyone who uses Ficl. If you have
+** a problem, a success story, a defect, an enhancement request, or
+** if you would like to contribute to the Ficl release, please
+** contact me by email at the address above.
+**
+** L I C E N S E and D I S C L A I M E R
+**
+** Redistribution and use in source and binary forms, with or without
+** modification, are permitted provided that the following conditions
+** are met:
+** 1. Redistributions of source code must retain the above copyright
+** notice, this list of conditions and the following disclaimer.
+** 2. Redistributions in binary form must reproduce the above copyright
+** notice, this list of conditions and the following disclaimer in the
+** documentation and/or other materials provided with the distribution.
+**
+** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+** SUCH DAMAGE.
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "ficl.h"
+
+
+int main(int argc, char **argv)
+{
+ int returnValue = 0;
+ char buffer[256];
+ ficlVm *vm;
+ ficlSystem *system;
+
+ system = ficlSystemCreate(NULL);
+ ficlSystemCompileExtras(system);
+ vm = ficlSystemCreateVm(system);
+
+ returnValue = ficlVmEvaluate(vm, ".ver .( " __DATE__ " ) cr quit");
+
+ /*
+ ** load files specified on command-line
+ */
+ if (argc > 1)
+ {
+ sprintf(buffer, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);
+ returnValue = ficlVmEvaluate(vm, buffer);
+ }
+
+ while (returnValue != FICL_VM_STATUS_USER_EXIT)
+ {
+ fputs(FICL_PROMPT, stdout);
+ fgets(buffer, sizeof(buffer), stdin);
+ returnValue = ficlVmEvaluate(vm, buffer);
+ }
+
+ ficlSystemDestroy(system);
+ return 0;
+}
+
projects / tools / librpm-tizen.git / commitdiff