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 */
14static void
15ficlPrimitiveSystem(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
42static void
43ficlPrimitiveLoad(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 */
124static void
125ficlPrimitiveSpewHash(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
165static void
166ficlPrimitiveBreak(ficlVm *vm)
167{
168	vm->state = vm->state;
169}
170
171void
172ficlSystemCompileExtras(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