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