Create.

CVS patchset: 4678
CVS date: 2001/04/13 19:24:16

diff --git a/rpmio/tficl.c b/rpmio/tficl.c
new file mode 100644 (file)
index 0000000..6cc87ed
--- /dev/null
+++ b/rpmio/tficl.c
@@ -0,0 +1,332 @@
+/*\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
+#ifdef WIN32\r
+#include <direct.h>\r
+#endif\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
+#ifdef WIN32   \r
+    cp = _getcwd(NULL, 80);\r
+#else\r
+   cp = getcwd(NULL, 80);\r
+#endif\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
+#ifdef WIN32\r
+       int err = _chdir(pFS->text);\r
+#else\r
+       int err = chdir(pFS->text);\r
+#endif\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
+#ifdef WIN32       \r
+    struct _stat buf;\r
+#else\r
+    struct stat buf;\r
+#endif\r
+\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
+#ifdef WIN32       \r
+    result = _stat( pFilename->text, &buf );\r
+#else\r
+    result = stat( pFilename->text, &buf );\r
+#endif\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
+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
+#if !defined (_WINDOWS)\r
+#define nINBUF 256\r
+int main(int argc, char **argv)\r
+{\r
+    char in[nINBUF];\r
+    FICL_VM *pVM;\r
+\r
+    ficlInitSystem(10000);\r
+    buildTestInterface();\r
+    pVM = ficlNewVM();\r
+\r
+    ficlExec(pVM, ".ver .( " __DATE__ " ) cr quit");\r
+\r
+    /*\r
+    ** load file from cmd line...\r
+    */\r
+    if (argc  > 1)\r
+    {\r
+        sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]);\r
+        ficlExec(pVM, in);\r
+    }\r
+\r
+    for (;;)\r
+    {\r
+        int ret;\r
+        fgets(in, nINBUF, stdin);\r
+        ret = ficlExec(pVM, in);\r
+        if (ret == VM_USEREXIT)\r
+        {\r
+            ficlTermSystem();\r
+            break;\r
+        }\r
+    }\r
+\r
+    return 0;\r
+}\r
+\r
+#endif\r
+\r