From d0594e1ce00578e3b2afad060076abd6c5fd9300 Mon Sep 17 00:00:00 2001 From: jbj Date: Thu, 26 Jun 2003 18:19:26 +0000 Subject: [PATCH] Update to 4.0.31. CVS patchset: 6919 CVS date: 2003/06/26 18:19:26 --- rpmio/Makefile.am | 2 +- rpmio/tficl.c | 400 +++++++++------------------------------------- 2 files changed, 79 insertions(+), 323 deletions(-) diff --git a/rpmio/Makefile.am b/rpmio/Makefile.am index 32596ba07..4ac62cdef 100644 --- a/rpmio/Makefile.am +++ b/rpmio/Makefile.am @@ -103,4 +103,4 @@ tficl.o: tficl.c $(COMPILE) -I/usr/include/ficl -o $@ -c tficl.c tficl: tficl.o - $(LINK) -o $@ tficl.o -lficl + $(LINK) -o $@ tficl.o -lficl -lm diff --git a/rpmio/tficl.c b/rpmio/tficl.c index a41c03b57..d82423d5b 100644 --- a/rpmio/tficl.c +++ b/rpmio/tficl.c @@ -1,322 +1,78 @@ -/* -** stub main for testing FICL under Win32 -** -*/ - -#include -#include -#include -#include -#include -#include -#ifdef linux -#include -#endif - -#include "ficl.h" - -/* -** Ficl interface to _getcwd (Win32) -** Prints the current working directory using the VM's -** textOut method... -*/ -static void ficlGetCWD(FICL_VM *pVM) -{ - char *cp; - - cp = getcwd(NULL, 80); - vmTextOut(pVM, cp, 1); - free(cp); - return; -} - -/* -** Ficl interface to _chdir (Win32) -** Gets a newline (or NULL) delimited string from the input -** and feeds it to the Win32 chdir function... -** Example: -** cd c:\tmp -*/ -static void ficlChDir(FICL_VM *pVM) -{ - FICL_STRING *pFS = (FICL_STRING *)pVM->pad; - vmGetString(pVM, pFS, '\n'); - if (pFS->count > 0) - { - int err = chdir(pFS->text); - if (err) - { - vmTextOut(pVM, "Error: path not found", 1); - vmThrow(pVM, VM_QUIT); - } - } - else - { - vmTextOut(pVM, "Warning (chdir): nothing happened", 1); - } - return; -} - -/* -** Ficl interface to system (ANSI) -** Gets a newline (or NULL) delimited string from the input -** and feeds it to the Win32 system function... -** Example: -** system del *.* -** \ ouch! -*/ -static void ficlSystem(FICL_VM *pVM) -{ - FICL_STRING *pFS = (FICL_STRING *)pVM->pad; - - vmGetString(pVM, pFS, '\n'); - if (pFS->count > 0) - { - int err = system(pFS->text); - if (err) - { - sprintf(pVM->pad, "System call returned %d", err); - vmTextOut(pVM, pVM->pad, 1); - vmThrow(pVM, VM_QUIT); - } - } - else - { - vmTextOut(pVM, "Warning (system): nothing happened", 1); - } - return; -} - -/* -** Ficl add-in to load a text file and execute it... -** Cheesy, but illustrative. -** Line oriented... filename is newline (or NULL) delimited. -** Example: -** load test.ficl -*/ -#define nLINEBUF 256 -static void ficlLoad(FICL_VM *pVM) -{ - char cp[nLINEBUF]; - char filename[nLINEBUF]; - FICL_STRING *pFilename = (FICL_STRING *)filename; - int nLine = 0; - FILE *fp; - int result; - CELL id; - struct stat buf; - - vmGetString(pVM, pFilename, '\n'); - - if (pFilename->count <= 0) - { - vmTextOut(pVM, "Warning (load): nothing happened", 1); - return; - } - - /* - ** get the file's size and make sure it exists - */ - result = stat( pFilename->text, &buf ); - - if (result != 0) - { - vmTextOut(pVM, "Unable to stat file: ", 0); - vmTextOut(pVM, pFilename->text, 1); - vmThrow(pVM, VM_QUIT); - } - - fp = fopen(pFilename->text, "r"); - if (!fp) - { - vmTextOut(pVM, "Unable to open file ", 0); - vmTextOut(pVM, pFilename->text, 1); - vmThrow(pVM, VM_QUIT); - } - - id = pVM->sourceID; - pVM->sourceID.p = (void *)fp; - - /* feed each line to ficlExec */ - while (fgets(cp, nLINEBUF, fp)) - { - int len = strlen(cp) - 1; - - nLine++; - if (len <= 0) - continue; - - if (cp[len] == '\n') - cp[len] = '\0'; - - result = ficlExec(pVM, cp); - if (result != VM_OUTOFTEXT) - { - pVM->sourceID = id; - fclose(fp); - vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine); - break; - } - } - /* - ** Pass an empty line with SOURCE-ID == -1 to flush - ** any pending REFILLs (as required by FILE wordset) - */ - pVM->sourceID.i = -1; - ficlExec(pVM, ""); - - pVM->sourceID = id; - fclose(fp); - - return; -} - -/* -** Dump a tab delimited file that summarizes the contents of the -** dictionary hash table by hashcode... -*/ -static void spewHash(FICL_VM *pVM) -{ - FICL_HASH *pHash = ficlGetDict()->pForthWords; - FICL_WORD *pFW; - FILE *pOut; - unsigned i; - unsigned nHash = pHash->size; - - if (!vmGetWordToPad(pVM)) - vmThrow(pVM, VM_OUTOFTEXT); - - pOut = fopen(pVM->pad, "w"); - if (!pOut) - { - vmTextOut(pVM, "unable to open file", 1); - return; - } - - for (i=0; i < nHash; i++) - { - int n = 0; - - pFW = pHash->table[i]; - while (pFW) - { - n++; - pFW = pFW->link; - } - - fprintf(pOut, "%d\t%d", i, n); - - pFW = pHash->table[i]; - while (pFW) - { - fprintf(pOut, "\t%s", pFW->name); - pFW = pFW->link; - } - - fprintf(pOut, "\n"); - } - - fclose(pOut); - return; -} - -static void ficlBreak(FICL_VM *pVM) -{ - pVM->state = pVM->state; - return; -} - -static void ficlClock(FICL_VM *pVM) -{ - clock_t now = clock(); - stackPushUNS(pVM->pStack, (UNS32)now); - return; -} - -static void clocksPerSec(FICL_VM *pVM) -{ - stackPushUNS(pVM->pStack, CLOCKS_PER_SEC); - return; -} - - -static void execxt(FICL_VM *pVM) -{ - FICL_WORD *pFW; -#if FICL_ROBUST > 1 - vmCheckStack(pVM, 1, 0); -#endif - - pFW = stackPopPtr(pVM->pStack); - ficlExecXT(pVM, pFW); - - return; -} - - -static void buildTestInterface(void) -{ - ficlBuild("break", ficlBreak, FW_DEFAULT); - ficlBuild("clock", ficlClock, FW_DEFAULT); - ficlBuild("cd", ficlChDir, FW_DEFAULT); - ficlBuild("execxt", execxt, FW_DEFAULT); - ficlBuild("load", ficlLoad, FW_DEFAULT); - ficlBuild("pwd", ficlGetCWD, FW_DEFAULT); - ficlBuild("system", ficlSystem, FW_DEFAULT); - ficlBuild("spewhash", spewHash, FW_DEFAULT); - ficlBuild("clocks/sec", - clocksPerSec, FW_DEFAULT); - - return; -} - - -static int quiet = 0; - -int main(int argc, char **argv) -{ - char in[BUFSIZ], * s; - FICL_VM *pVM; - extern char * optarg; - extern int optind, opterr, optopt; - int errflg = 0; - int ret; - int c; - - while ((c = getopt(argc, argv, "q")) != EOF) - switch (c) { - case 'q': - quiet++; - break; - case '?': - default: - errflg++; - break; - } - - ficlInitSystem(10000); - buildTestInterface(); - pVM = ficlNewVM(); - - if (!quiet) - ficlExec(pVM, ".ver .( " __DATE__ " ) cr quit"); - - for ( ; optind < argc; optind++) { - sprintf(in, ".( loading %s ) cr load %s\n cr", argv[optind], argv[optind]); - ficlExec(pVM, in); - } - - s = in; - if (!quiet) - *s++ = '\n'; - *s++ = '\0'; - ret = 0; - do { - if (in[0]) - ret = ficlExec(pVM, in); - } while (ret != VM_USEREXIT && (s = fgets(in, sizeof(in)-1, stdin)) != NULL); - - ficlTermSystem(); - - return 0; -} +/* +** 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 +#include + +#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; +} +