1afc2ba1dSToomas Soome #include "ficl.h"
2afc2ba1dSToomas Soome #include <unistd.h>
3afc2ba1dSToomas Soome #include <stdio.h>
4afc2ba1dSToomas Soome #include <stdlib.h>
5afc2ba1dSToomas Soome
6afc2ba1dSToomas Soome /*
7afc2ba1dSToomas Soome * Ficl interface to system (ANSI)
8afc2ba1dSToomas Soome * Gets a newline (or NULL) delimited string from the input
9afc2ba1dSToomas Soome * and feeds it to the ANSI system function...
10afc2ba1dSToomas Soome * Example:
11afc2ba1dSToomas Soome * system del *.*
12afc2ba1dSToomas Soome * \ ouch!
13afc2ba1dSToomas Soome */
14afc2ba1dSToomas Soome static void
ficlPrimitiveSystem(ficlVm * vm)15afc2ba1dSToomas Soome ficlPrimitiveSystem(ficlVm *vm)
16afc2ba1dSToomas Soome {
17afc2ba1dSToomas Soome ficlCountedString *counted = (ficlCountedString *)vm->pad;
18afc2ba1dSToomas Soome
19*c0bb4f73SToomas Soome (void) ficlVmGetString(vm, counted, '\n');
20afc2ba1dSToomas Soome if (FICL_COUNTED_STRING_GET_LENGTH(*counted) > 0) {
21afc2ba1dSToomas Soome int returnValue = \
22afc2ba1dSToomas Soome system(FICL_COUNTED_STRING_GET_POINTER(*counted));
23afc2ba1dSToomas Soome if (returnValue) {
24*c0bb4f73SToomas Soome (void) sprintf(vm->pad, "System call returned %d\n",
25afc2ba1dSToomas Soome returnValue);
26afc2ba1dSToomas Soome ficlVmTextOut(vm, vm->pad);
27afc2ba1dSToomas Soome ficlVmThrow(vm, FICL_VM_STATUS_QUIT);
28afc2ba1dSToomas Soome }
29afc2ba1dSToomas Soome } else {
30afc2ba1dSToomas Soome ficlVmTextOut(vm, "Warning (system): nothing happened\n");
31afc2ba1dSToomas Soome }
32afc2ba1dSToomas Soome }
33afc2ba1dSToomas Soome
34afc2ba1dSToomas Soome /*
35afc2ba1dSToomas Soome * Ficl add-in to load a text file and execute it...
36afc2ba1dSToomas Soome * Cheesy, but illustrative.
37afc2ba1dSToomas Soome * Line oriented... filename is newline (or NULL) delimited.
38afc2ba1dSToomas Soome * Example:
39afc2ba1dSToomas Soome * load test.f
40afc2ba1dSToomas Soome */
41afc2ba1dSToomas Soome #define BUFFER_SIZE 256
42afc2ba1dSToomas Soome static void
ficlPrimitiveLoad(ficlVm * vm)43afc2ba1dSToomas Soome ficlPrimitiveLoad(ficlVm *vm)
44afc2ba1dSToomas Soome {
45afc2ba1dSToomas Soome char buffer[BUFFER_SIZE];
46afc2ba1dSToomas Soome char filename[BUFFER_SIZE];
47afc2ba1dSToomas Soome ficlCountedString *counted = (ficlCountedString *)filename;
48afc2ba1dSToomas Soome int line = 0;
49afc2ba1dSToomas Soome FILE *f;
50afc2ba1dSToomas Soome int result = 0;
51afc2ba1dSToomas Soome ficlCell oldSourceId;
52afc2ba1dSToomas Soome ficlString s;
53afc2ba1dSToomas Soome
54*c0bb4f73SToomas Soome (void) ficlVmGetString(vm, counted, '\n');
55afc2ba1dSToomas Soome
56afc2ba1dSToomas Soome if (FICL_COUNTED_STRING_GET_LENGTH(*counted) <= 0) {
57afc2ba1dSToomas Soome ficlVmTextOut(vm, "Warning (load): nothing happened\n");
58afc2ba1dSToomas Soome return;
59afc2ba1dSToomas Soome }
60afc2ba1dSToomas Soome
61afc2ba1dSToomas Soome /*
62afc2ba1dSToomas Soome * get the file's size and make sure it exists
63afc2ba1dSToomas Soome */
64afc2ba1dSToomas Soome
65afc2ba1dSToomas Soome f = fopen(FICL_COUNTED_STRING_GET_POINTER(*counted), "r");
66afc2ba1dSToomas Soome if (!f) {
67afc2ba1dSToomas Soome ficlVmTextOut(vm, "Unable to open file ");
68afc2ba1dSToomas Soome ficlVmTextOut(vm, FICL_COUNTED_STRING_GET_POINTER(*counted));
69afc2ba1dSToomas Soome ficlVmTextOut(vm, "\n");
70afc2ba1dSToomas Soome ficlVmThrow(vm, FICL_VM_STATUS_QUIT);
71afc2ba1dSToomas Soome }
72afc2ba1dSToomas Soome
73afc2ba1dSToomas Soome oldSourceId = vm->sourceId;
74afc2ba1dSToomas Soome vm->sourceId.p = (void *)f;
75afc2ba1dSToomas Soome
76afc2ba1dSToomas Soome /* feed each line to ficlExec */
77afc2ba1dSToomas Soome while (fgets(buffer, BUFFER_SIZE, f)) {
78afc2ba1dSToomas Soome int length = strlen(buffer) - 1;
79afc2ba1dSToomas Soome
80afc2ba1dSToomas Soome line++;
81afc2ba1dSToomas Soome if (length <= 0)
82afc2ba1dSToomas Soome continue;
83afc2ba1dSToomas Soome
84afc2ba1dSToomas Soome if (buffer[length] == '\n')
85afc2ba1dSToomas Soome buffer[length--] = '\0';
86afc2ba1dSToomas Soome
87afc2ba1dSToomas Soome FICL_STRING_SET_POINTER(s, buffer);
88afc2ba1dSToomas Soome FICL_STRING_SET_LENGTH(s, length + 1);
89afc2ba1dSToomas Soome result = ficlVmExecuteString(vm, s);
90afc2ba1dSToomas Soome /* handle "bye" in loaded files. --lch */
91afc2ba1dSToomas Soome switch (result) {
92afc2ba1dSToomas Soome case FICL_VM_STATUS_OUT_OF_TEXT:
93afc2ba1dSToomas Soome case FICL_VM_STATUS_USER_EXIT:
94afc2ba1dSToomas Soome break;
95afc2ba1dSToomas Soome
96afc2ba1dSToomas Soome default:
97afc2ba1dSToomas Soome vm->sourceId = oldSourceId;
98*c0bb4f73SToomas Soome (void) fclose(f);
99afc2ba1dSToomas Soome ficlVmThrowError(vm, "Error loading file <%s> line %d",
100afc2ba1dSToomas Soome FICL_COUNTED_STRING_GET_POINTER(*counted), line);
101afc2ba1dSToomas Soome break;
102afc2ba1dSToomas Soome }
103afc2ba1dSToomas Soome }
104afc2ba1dSToomas Soome /*
105afc2ba1dSToomas Soome * Pass an empty line with SOURCE-ID == -1 to flush
106afc2ba1dSToomas Soome * any pending REFILLs (as required by FILE wordset)
107afc2ba1dSToomas Soome */
108afc2ba1dSToomas Soome vm->sourceId.i = -1;
109afc2ba1dSToomas Soome FICL_STRING_SET_FROM_CSTRING(s, "");
110*c0bb4f73SToomas Soome (void) ficlVmExecuteString(vm, s);
111afc2ba1dSToomas Soome
112afc2ba1dSToomas Soome vm->sourceId = oldSourceId;
113*c0bb4f73SToomas Soome (void) fclose(f);
114afc2ba1dSToomas Soome
115afc2ba1dSToomas Soome /* handle "bye" in loaded files. --lch */
116afc2ba1dSToomas Soome if (result == FICL_VM_STATUS_USER_EXIT)
117afc2ba1dSToomas Soome ficlVmThrow(vm, FICL_VM_STATUS_USER_EXIT);
118afc2ba1dSToomas Soome }
119afc2ba1dSToomas Soome
120afc2ba1dSToomas Soome /*
121afc2ba1dSToomas Soome * Dump a tab delimited file that summarizes the contents of the
122afc2ba1dSToomas Soome * dictionary hash table by hashcode...
123afc2ba1dSToomas Soome */
124afc2ba1dSToomas Soome static void
ficlPrimitiveSpewHash(ficlVm * vm)125afc2ba1dSToomas Soome ficlPrimitiveSpewHash(ficlVm *vm)
126afc2ba1dSToomas Soome {
127afc2ba1dSToomas Soome ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist;
128afc2ba1dSToomas Soome ficlWord *word;
129afc2ba1dSToomas Soome FILE *f;
130afc2ba1dSToomas Soome unsigned i;
131afc2ba1dSToomas Soome unsigned hashSize = hash->size;
132afc2ba1dSToomas Soome
133afc2ba1dSToomas Soome if (!ficlVmGetWordToPad(vm))
134afc2ba1dSToomas Soome ficlVmThrow(vm, FICL_VM_STATUS_OUT_OF_TEXT);
135afc2ba1dSToomas Soome
136afc2ba1dSToomas Soome f = fopen(vm->pad, "w");
137afc2ba1dSToomas Soome if (!f) {
138afc2ba1dSToomas Soome ficlVmTextOut(vm, "unable to open file\n");
139afc2ba1dSToomas Soome return;
140afc2ba1dSToomas Soome }
141afc2ba1dSToomas Soome
142afc2ba1dSToomas Soome for (i = 0; i < hashSize; i++) {
143afc2ba1dSToomas Soome int n = 0;
144afc2ba1dSToomas Soome
145afc2ba1dSToomas Soome word = hash->table[i];
146afc2ba1dSToomas Soome while (word) {
147afc2ba1dSToomas Soome n++;
148afc2ba1dSToomas Soome word = word->link;
149afc2ba1dSToomas Soome }
150afc2ba1dSToomas Soome
151*c0bb4f73SToomas Soome (void) fprintf(f, "%d\t%d", i, n);
152afc2ba1dSToomas Soome
153afc2ba1dSToomas Soome word = hash->table[i];
154afc2ba1dSToomas Soome while (word) {
155*c0bb4f73SToomas Soome (void) fprintf(f, "\t%s", word->name);
156afc2ba1dSToomas Soome word = word->link;
157afc2ba1dSToomas Soome }
158afc2ba1dSToomas Soome
159*c0bb4f73SToomas Soome (void) fprintf(f, "\n");
160afc2ba1dSToomas Soome }
161afc2ba1dSToomas Soome
162*c0bb4f73SToomas Soome (void) fclose(f);
163afc2ba1dSToomas Soome }
164afc2ba1dSToomas Soome
165afc2ba1dSToomas Soome static void
ficlPrimitiveBreak(ficlVm * vm)166afc2ba1dSToomas Soome ficlPrimitiveBreak(ficlVm *vm)
167afc2ba1dSToomas Soome {
168afc2ba1dSToomas Soome vm->state = vm->state;
169afc2ba1dSToomas Soome }
170afc2ba1dSToomas Soome
171afc2ba1dSToomas Soome void
ficlSystemCompileExtras(ficlSystem * system)172afc2ba1dSToomas Soome ficlSystemCompileExtras(ficlSystem *system)
173afc2ba1dSToomas Soome {
174afc2ba1dSToomas Soome ficlDictionary *dictionary = ficlSystemGetDictionary(system);
175afc2ba1dSToomas Soome
176*c0bb4f73SToomas Soome (void) ficlDictionarySetPrimitive(dictionary, "break",
177*c0bb4f73SToomas Soome ficlPrimitiveBreak, FICL_WORD_DEFAULT);
178*c0bb4f73SToomas Soome (void) ficlDictionarySetPrimitive(dictionary, "load",
179*c0bb4f73SToomas Soome ficlPrimitiveLoad, FICL_WORD_DEFAULT);
180*c0bb4f73SToomas Soome (void) ficlDictionarySetPrimitive(dictionary, "spewhash",
181afc2ba1dSToomas Soome ficlPrimitiveSpewHash, FICL_WORD_DEFAULT);
182*c0bb4f73SToomas Soome (void) ficlDictionarySetPrimitive(dictionary, "system",
183*c0bb4f73SToomas Soome ficlPrimitiveSystem, FICL_WORD_DEFAULT);
184afc2ba1dSToomas Soome }
185