← Back to branch summary

~ubuntu-branches/ubuntu/edgy/rpm/edgy

« back to all changes in this revision

Viewing changes to rpmio/tficl.c

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2002-01-22 20:56:57 UTC
  • Revision ID: james.westby@ubuntu.com-20020122205657-l74j50mr9z8ofcl5
Tags: upstream-4.0.3
Import upstream version 4.0.3

Show diffs side-by-side

added added

removed removed

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