xref: /titanic_54/usr/src/common/ficl/loader.c (revision d5a0772bd7066293674d17391f116c692addc58d)
1a1bf3f78SToomas Soome /*
2a1bf3f78SToomas Soome  * Copyright (c) 2000 Daniel Capo Sobral
3a1bf3f78SToomas Soome  * All rights reserved.
4a1bf3f78SToomas Soome  *
5a1bf3f78SToomas Soome  * Redistribution and use in source and binary forms, with or without
6a1bf3f78SToomas Soome  * modification, are permitted provided that the following conditions
7a1bf3f78SToomas Soome  * are met:
8a1bf3f78SToomas Soome  * 1. Redistributions of source code must retain the above copyright
9a1bf3f78SToomas Soome  *    notice, this list of conditions and the following disclaimer.
10a1bf3f78SToomas Soome  * 2. Redistributions in binary form must reproduce the above copyright
11a1bf3f78SToomas Soome  *    notice, this list of conditions and the following disclaimer in the
12a1bf3f78SToomas Soome  *    documentation and/or other materials provided with the distribution.
13a1bf3f78SToomas Soome  *
14a1bf3f78SToomas Soome  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
15a1bf3f78SToomas Soome  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
16a1bf3f78SToomas Soome  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
17a1bf3f78SToomas Soome  * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
18a1bf3f78SToomas Soome  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
19a1bf3f78SToomas Soome  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
20a1bf3f78SToomas Soome  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21a1bf3f78SToomas Soome  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
22a1bf3f78SToomas Soome  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
23a1bf3f78SToomas Soome  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
24a1bf3f78SToomas Soome  * SUCH DAMAGE.
25a1bf3f78SToomas Soome  *
26a1bf3f78SToomas Soome  *	$FreeBSD$
27a1bf3f78SToomas Soome  */
28a1bf3f78SToomas Soome 
29a1bf3f78SToomas Soome /*
30a1bf3f78SToomas Soome  * l o a d e r . c
31a1bf3f78SToomas Soome  * Additional FICL words designed for FreeBSD's loader
32a1bf3f78SToomas Soome  */
33a1bf3f78SToomas Soome 
34a1bf3f78SToomas Soome #ifndef STAND
35a1bf3f78SToomas Soome #include <sys/types.h>
36a1bf3f78SToomas Soome #include <sys/stat.h>
37a1bf3f78SToomas Soome #include <dirent.h>
38a1bf3f78SToomas Soome #include <fcntl.h>
39a1bf3f78SToomas Soome #include <stdio.h>
40a1bf3f78SToomas Soome #include <stdlib.h>
41a1bf3f78SToomas Soome #include <unistd.h>
42a1bf3f78SToomas Soome #include <strings.h>
43a1bf3f78SToomas Soome #include <termios.h>
44a1bf3f78SToomas Soome #else
45a1bf3f78SToomas Soome #include <stand.h>
46a1bf3f78SToomas Soome #ifdef __i386__
47a1bf3f78SToomas Soome #include <machine/cpufunc.h>
48a1bf3f78SToomas Soome #endif
49a1bf3f78SToomas Soome #include "bootstrap.h"
50a1bf3f78SToomas Soome #endif
51065446baSToomas Soome #ifdef STAND
52065446baSToomas Soome #include <uuid.h>
53065446baSToomas Soome #else
54065446baSToomas Soome #include <uuid/uuid.h>
55065446baSToomas Soome #endif
56a1bf3f78SToomas Soome #include <string.h>
57a1bf3f78SToomas Soome #include "ficl.h"
58a1bf3f78SToomas Soome 
59a1bf3f78SToomas Soome /*
60a1bf3f78SToomas Soome  *		FreeBSD's loader interaction words and extras
61a1bf3f78SToomas Soome  *
62a1bf3f78SToomas Soome  *		setenv      ( value n name n' -- )
63a1bf3f78SToomas Soome  *		setenv?     ( value n name n' flag -- )
64a1bf3f78SToomas Soome  *		getenv      ( addr n -- addr' n' | -1 )
65a1bf3f78SToomas Soome  *		unsetenv    ( addr n -- )
66a1bf3f78SToomas Soome  *		copyin      ( addr addr' len -- )
67a1bf3f78SToomas Soome  *		copyout     ( addr addr' len -- )
68a1bf3f78SToomas Soome  *		findfile    ( name len type len' -- addr )
69a1bf3f78SToomas Soome  *		ccall       ( [[...[p10] p9] ... p1] n addr -- result )
70065446baSToomas Soome  *		uuid-from-string ( addr n -- addr' )
71065446baSToomas Soome  *		uuid-to-string ( addr' -- addr n | -1 )
72a1bf3f78SToomas Soome  *		.#	    ( value -- )
73a1bf3f78SToomas Soome  */
74a1bf3f78SToomas Soome 
75a1bf3f78SToomas Soome void
76a1bf3f78SToomas Soome ficlSetenv(ficlVm *pVM)
77a1bf3f78SToomas Soome {
78a1bf3f78SToomas Soome 	char *name, *value;
79a1bf3f78SToomas Soome 	char *namep, *valuep;
80a1bf3f78SToomas Soome 	int names, values;
81a1bf3f78SToomas Soome 
82a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 4, 0);
83a1bf3f78SToomas Soome 
84a1bf3f78SToomas Soome 	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
85a1bf3f78SToomas Soome 	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
86a1bf3f78SToomas Soome 	values = ficlStackPopInteger(ficlVmGetDataStack(pVM));
87a1bf3f78SToomas Soome 	valuep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
88a1bf3f78SToomas Soome 
89a1bf3f78SToomas Soome 	name = (char *)ficlMalloc(names+1);
90a1bf3f78SToomas Soome 	if (!name)
91a1bf3f78SToomas Soome 		ficlVmThrowError(pVM, "Error: out of memory");
92a1bf3f78SToomas Soome 	strncpy(name, namep, names);
93a1bf3f78SToomas Soome 	name[names] = '\0';
94a1bf3f78SToomas Soome 	value = (char *)ficlMalloc(values+1);
95a1bf3f78SToomas Soome 	if (!value)
96a1bf3f78SToomas Soome 		ficlVmThrowError(pVM, "Error: out of memory");
97a1bf3f78SToomas Soome 	strncpy(value, valuep, values);
98a1bf3f78SToomas Soome 	value[values] = '\0';
99a1bf3f78SToomas Soome 
100a1bf3f78SToomas Soome 	setenv(name, value, 1);
101a1bf3f78SToomas Soome 	ficlFree(name);
102a1bf3f78SToomas Soome 	ficlFree(value);
103a1bf3f78SToomas Soome }
104a1bf3f78SToomas Soome 
105a1bf3f78SToomas Soome void
106a1bf3f78SToomas Soome ficlSetenvq(ficlVm *pVM)
107a1bf3f78SToomas Soome {
108a1bf3f78SToomas Soome 	char *name, *value;
109a1bf3f78SToomas Soome 	char *namep, *valuep;
110a1bf3f78SToomas Soome 	int names, values, overwrite;
111a1bf3f78SToomas Soome 
112a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 5, 0);
113a1bf3f78SToomas Soome 
114a1bf3f78SToomas Soome 	overwrite = ficlStackPopInteger(ficlVmGetDataStack(pVM));
115a1bf3f78SToomas Soome 	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
116a1bf3f78SToomas Soome 	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
117a1bf3f78SToomas Soome 	values = ficlStackPopInteger(ficlVmGetDataStack(pVM));
118a1bf3f78SToomas Soome 	valuep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
119a1bf3f78SToomas Soome 
120a1bf3f78SToomas Soome 	name = (char *)ficlMalloc(names+1);
121a1bf3f78SToomas Soome 	if (!name)
122a1bf3f78SToomas Soome 		ficlVmThrowError(pVM, "Error: out of memory");
123a1bf3f78SToomas Soome 	strncpy(name, namep, names);
124a1bf3f78SToomas Soome 	name[names] = '\0';
125a1bf3f78SToomas Soome 	value = (char *)ficlMalloc(values+1);
126a1bf3f78SToomas Soome 	if (!value)
127a1bf3f78SToomas Soome 		ficlVmThrowError(pVM, "Error: out of memory");
128a1bf3f78SToomas Soome 	strncpy(value, valuep, values);
129a1bf3f78SToomas Soome 	value[values] = '\0';
130a1bf3f78SToomas Soome 
131a1bf3f78SToomas Soome 	setenv(name, value, overwrite);
132a1bf3f78SToomas Soome 	ficlFree(name);
133a1bf3f78SToomas Soome 	ficlFree(value);
134a1bf3f78SToomas Soome }
135a1bf3f78SToomas Soome 
136a1bf3f78SToomas Soome void
137a1bf3f78SToomas Soome ficlGetenv(ficlVm *pVM)
138a1bf3f78SToomas Soome {
139a1bf3f78SToomas Soome 	char *name, *value;
140a1bf3f78SToomas Soome 	char *namep;
141a1bf3f78SToomas Soome 	int names;
142a1bf3f78SToomas Soome 
143a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 2);
144a1bf3f78SToomas Soome 
145a1bf3f78SToomas Soome 	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
146a1bf3f78SToomas Soome 	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
147a1bf3f78SToomas Soome 
148a1bf3f78SToomas Soome 	name = (char *)ficlMalloc(names+1);
149a1bf3f78SToomas Soome 	if (!name)
150a1bf3f78SToomas Soome 		ficlVmThrowError(pVM, "Error: out of memory");
151a1bf3f78SToomas Soome 	strncpy(name, namep, names);
152a1bf3f78SToomas Soome 	name[names] = '\0';
153a1bf3f78SToomas Soome 
154a1bf3f78SToomas Soome 	value = getenv(name);
155a1bf3f78SToomas Soome 	ficlFree(name);
156a1bf3f78SToomas Soome 
157a1bf3f78SToomas Soome 	if (value != NULL) {
158a1bf3f78SToomas Soome 		ficlStackPushPointer(ficlVmGetDataStack(pVM), value);
159a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(value));
160a1bf3f78SToomas Soome 	} else
161a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
162a1bf3f78SToomas Soome }
163a1bf3f78SToomas Soome 
164a1bf3f78SToomas Soome void
165a1bf3f78SToomas Soome ficlUnsetenv(ficlVm *pVM)
166a1bf3f78SToomas Soome {
167a1bf3f78SToomas Soome 	char *name;
168a1bf3f78SToomas Soome 	char *namep;
169a1bf3f78SToomas Soome 	int names;
170a1bf3f78SToomas Soome 
171a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0);
172a1bf3f78SToomas Soome 
173a1bf3f78SToomas Soome 	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
174a1bf3f78SToomas Soome 	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
175a1bf3f78SToomas Soome 
176a1bf3f78SToomas Soome 	name = (char *)ficlMalloc(names+1);
177a1bf3f78SToomas Soome 	if (!name)
178a1bf3f78SToomas Soome 		ficlVmThrowError(pVM, "Error: out of memory");
179a1bf3f78SToomas Soome 	strncpy(name, namep, names);
180a1bf3f78SToomas Soome 	name[names] = '\0';
181a1bf3f78SToomas Soome 
182a1bf3f78SToomas Soome 	unsetenv(name);
183a1bf3f78SToomas Soome 	ficlFree(name);
184a1bf3f78SToomas Soome }
185a1bf3f78SToomas Soome 
186a1bf3f78SToomas Soome void
187a1bf3f78SToomas Soome ficlCopyin(ficlVm *pVM)
188a1bf3f78SToomas Soome {
189a1bf3f78SToomas Soome #ifdef STAND
190a1bf3f78SToomas Soome 	void*		src;
191a1bf3f78SToomas Soome 	vm_offset_t	dest;
192a1bf3f78SToomas Soome 	size_t		len;
193a1bf3f78SToomas Soome #endif
194a1bf3f78SToomas Soome 
195a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 0);
196a1bf3f78SToomas Soome 
197a1bf3f78SToomas Soome #ifdef STAND
198a1bf3f78SToomas Soome 	len = ficlStackPopInteger(ficlVmGetDataStack(pVM));
199a1bf3f78SToomas Soome 	dest = ficlStackPopInteger(ficlVmGetDataStack(pVM));
200a1bf3f78SToomas Soome 	src = ficlStackPopPointer(ficlVmGetDataStack(pVM));
201a1bf3f78SToomas Soome 	archsw.arch_copyin(src, dest, len);
202a1bf3f78SToomas Soome #else
203a1bf3f78SToomas Soome 	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
204a1bf3f78SToomas Soome 	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
205a1bf3f78SToomas Soome 	(void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
206a1bf3f78SToomas Soome #endif
207a1bf3f78SToomas Soome }
208a1bf3f78SToomas Soome 
209a1bf3f78SToomas Soome void
210a1bf3f78SToomas Soome ficlCopyout(ficlVm *pVM)
211a1bf3f78SToomas Soome {
212a1bf3f78SToomas Soome #ifdef STAND
213a1bf3f78SToomas Soome 	void*		dest;
214a1bf3f78SToomas Soome 	vm_offset_t	src;
215a1bf3f78SToomas Soome 	size_t		len;
216a1bf3f78SToomas Soome #endif
217a1bf3f78SToomas Soome 
218a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 0);
219a1bf3f78SToomas Soome 
220a1bf3f78SToomas Soome #ifdef STAND
221a1bf3f78SToomas Soome 	len = ficlStackPopInteger(ficlVmGetDataStack(pVM));
222a1bf3f78SToomas Soome 	dest = ficlStackPopPointer(ficlVmGetDataStack(pVM));
223a1bf3f78SToomas Soome 	src = ficlStackPopInteger(ficlVmGetDataStack(pVM));
224a1bf3f78SToomas Soome 	archsw.arch_copyout(src, dest, len);
225a1bf3f78SToomas Soome #else
226a1bf3f78SToomas Soome 	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
227a1bf3f78SToomas Soome 	(void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
228a1bf3f78SToomas Soome 	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
229a1bf3f78SToomas Soome #endif
230a1bf3f78SToomas Soome }
231a1bf3f78SToomas Soome 
232a1bf3f78SToomas Soome void
233a1bf3f78SToomas Soome ficlFindfile(ficlVm *pVM)
234a1bf3f78SToomas Soome {
235a1bf3f78SToomas Soome #ifdef STAND
236a1bf3f78SToomas Soome 	char	*name, *type;
237a1bf3f78SToomas Soome 	char	*namep, *typep;
238a1bf3f78SToomas Soome 	int	names, types;
239a1bf3f78SToomas Soome #endif
240a1bf3f78SToomas Soome 	struct	preloaded_file *fp;
241a1bf3f78SToomas Soome 
242a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 4, 1);
243a1bf3f78SToomas Soome 
244a1bf3f78SToomas Soome #ifdef STAND
245a1bf3f78SToomas Soome 	types = ficlStackPopInteger(ficlVmGetDataStack(pVM));
246a1bf3f78SToomas Soome 	typep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
247a1bf3f78SToomas Soome 	names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
248a1bf3f78SToomas Soome 	namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
249a1bf3f78SToomas Soome 
250a1bf3f78SToomas Soome 	name = (char *)ficlMalloc(names+1);
251a1bf3f78SToomas Soome 	if (!name)
252a1bf3f78SToomas Soome 		ficlVmThrowError(pVM, "Error: out of memory");
253a1bf3f78SToomas Soome 	strncpy(name, namep, names);
254a1bf3f78SToomas Soome 	name[names] = '\0';
255a1bf3f78SToomas Soome 	type = (char *)ficlMalloc(types+1);
256a1bf3f78SToomas Soome 	if (!type)
257a1bf3f78SToomas Soome 		ficlVmThrowError(pVM, "Error: out of memory");
258a1bf3f78SToomas Soome 	strncpy(type, typep, types);
259a1bf3f78SToomas Soome 	type[types] = '\0';
260a1bf3f78SToomas Soome 
261a1bf3f78SToomas Soome 	fp = file_findfile(name, type);
262a1bf3f78SToomas Soome #else
263a1bf3f78SToomas Soome 	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
264a1bf3f78SToomas Soome 	(void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
265a1bf3f78SToomas Soome 	(void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
266a1bf3f78SToomas Soome 	(void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
267a1bf3f78SToomas Soome 
268a1bf3f78SToomas Soome 	fp = NULL;
269a1bf3f78SToomas Soome #endif
270a1bf3f78SToomas Soome 	ficlStackPushPointer(ficlVmGetDataStack(pVM), fp);
271a1bf3f78SToomas Soome }
272a1bf3f78SToomas Soome 
273a1bf3f78SToomas Soome void
274a1bf3f78SToomas Soome ficlCcall(ficlVm *pVM)
275a1bf3f78SToomas Soome {
276a1bf3f78SToomas Soome 	int (*func)(int, ...);
277a1bf3f78SToomas Soome 	int result, p[10];
278a1bf3f78SToomas Soome 	int nparam, i;
279a1bf3f78SToomas Soome 
280a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0);
281a1bf3f78SToomas Soome 
282a1bf3f78SToomas Soome 	func = (int (*)(int, ...))ficlStackPopPointer(ficlVmGetDataStack(pVM));
283a1bf3f78SToomas Soome 	nparam = ficlStackPopInteger(ficlVmGetDataStack(pVM));
284a1bf3f78SToomas Soome 
285a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), nparam, 1);
286a1bf3f78SToomas Soome 
287a1bf3f78SToomas Soome 	for (i = 0; i < nparam; i++)
288a1bf3f78SToomas Soome 		p[i] = ficlStackPopInteger(ficlVmGetDataStack(pVM));
289a1bf3f78SToomas Soome 
290a1bf3f78SToomas Soome 	result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8],
291a1bf3f78SToomas Soome 	    p[9]);
292a1bf3f78SToomas Soome 
293a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM), result);
294a1bf3f78SToomas Soome }
295a1bf3f78SToomas Soome 
296065446baSToomas Soome void
297065446baSToomas Soome ficlUuidFromString(ficlVm *pVM)
298065446baSToomas Soome {
299065446baSToomas Soome 	char	*uuid;
300065446baSToomas Soome 	char	*uuid_ptr;
301065446baSToomas Soome 	int	uuid_size;
302065446baSToomas Soome 	uuid_t	*u;
303065446baSToomas Soome #ifdef STAND
304065446baSToomas Soome 	uint32_t status;
305065446baSToomas Soome #else
306065446baSToomas Soome 	int status;
307065446baSToomas Soome #endif
308065446baSToomas Soome 
309065446baSToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0);
310065446baSToomas Soome 
311065446baSToomas Soome 	uuid_size = ficlStackPopInteger(ficlVmGetDataStack(pVM));
312065446baSToomas Soome 	uuid_ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM));
313065446baSToomas Soome 
314065446baSToomas Soome 	uuid = ficlMalloc(uuid_size + 1);
315065446baSToomas Soome 	if (!uuid)
316065446baSToomas Soome 		ficlVmThrowError(pVM, "Error: out of memory");
317065446baSToomas Soome 	(void) memcpy(uuid, uuid_ptr, uuid_size);
318065446baSToomas Soome 	uuid[uuid_size] = '\0';
319065446baSToomas Soome 
320065446baSToomas Soome 	u = ficlMalloc(sizeof (*u));
321065446baSToomas Soome #ifdef STAND
322065446baSToomas Soome 	uuid_from_string(uuid, u, &status);
323065446baSToomas Soome 	ficlFree(uuid);
324065446baSToomas Soome 	if (status != uuid_s_ok) {
325065446baSToomas Soome 		ficlFree(u);
326065446baSToomas Soome 		u = NULL;
327065446baSToomas Soome 	}
328065446baSToomas Soome #else
329065446baSToomas Soome 	status = uuid_parse(uuid, *u);
330065446baSToomas Soome 	ficlFree(uuid);
331065446baSToomas Soome 	if (status != 0) {
332065446baSToomas Soome 		ficlFree(u);
333065446baSToomas Soome 		u = NULL;
334065446baSToomas Soome 	}
335065446baSToomas Soome #endif
336065446baSToomas Soome 	ficlStackPushPointer(ficlVmGetDataStack(pVM), u);
337065446baSToomas Soome }
338065446baSToomas Soome 
339065446baSToomas Soome void
340065446baSToomas Soome ficlUuidToString(ficlVm *pVM)
341065446baSToomas Soome {
342065446baSToomas Soome 	char	*uuid;
343065446baSToomas Soome 	uuid_t	*u;
344065446baSToomas Soome #ifdef STAND
345065446baSToomas Soome 	uint32_t status;
346065446baSToomas Soome #endif
347065446baSToomas Soome 
348065446baSToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
349065446baSToomas Soome 
350065446baSToomas Soome 	u = ficlStackPopPointer(ficlVmGetDataStack(pVM));
351065446baSToomas Soome #ifdef STAND
352065446baSToomas Soome 	uuid_to_string(u, &uuid, &status);
353065446baSToomas Soome 	if (status == uuid_s_ok) {
354065446baSToomas Soome 		ficlStackPushPointer(ficlVmGetDataStack(pVM), uuid);
355065446baSToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(uuid));
356065446baSToomas Soome 	} else
357065446baSToomas Soome #else
358065446baSToomas Soome 	uuid = ficlMalloc(UUID_PRINTABLE_STRING_LENGTH);
359065446baSToomas Soome 	if (uuid != NULL) {
360065446baSToomas Soome 		uuid_unparse(*u, uuid);
361065446baSToomas Soome 		ficlStackPushPointer(ficlVmGetDataStack(pVM), uuid);
362065446baSToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(uuid));
363065446baSToomas Soome 	} else
364065446baSToomas Soome #endif
365065446baSToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
366065446baSToomas Soome }
367065446baSToomas Soome 
368a1bf3f78SToomas Soome /*
369a1bf3f78SToomas Soome  * f i c l E x e c F D
370a1bf3f78SToomas Soome  * reads in text from file fd and passes it to ficlExec()
371a1bf3f78SToomas Soome  * returns FICL_VM_STATUS_OUT_OF_TEXT on success or the ficlExec() error
372a1bf3f78SToomas Soome  * code on failure.
373a1bf3f78SToomas Soome  */
374a1bf3f78SToomas Soome #define	nLINEBUF	256
375a1bf3f78SToomas Soome int
376a1bf3f78SToomas Soome ficlExecFD(ficlVm *pVM, int fd)
377a1bf3f78SToomas Soome {
378a1bf3f78SToomas Soome 	char cp[nLINEBUF];
379a1bf3f78SToomas Soome 	int nLine = 0, rval = FICL_VM_STATUS_OUT_OF_TEXT;
380a1bf3f78SToomas Soome 	char ch;
381a1bf3f78SToomas Soome 	ficlCell id;
382a1bf3f78SToomas Soome 	ficlString s;
383a1bf3f78SToomas Soome 
384a1bf3f78SToomas Soome 	id = pVM->sourceId;
385a1bf3f78SToomas Soome 	pVM->sourceId.i = fd+1; /* in loader we can get 0, there is no stdin */
386a1bf3f78SToomas Soome 
387a1bf3f78SToomas Soome 	/* feed each line to ficlExec */
388a1bf3f78SToomas Soome 	while (1) {
389a1bf3f78SToomas Soome 		int status, i;
390a1bf3f78SToomas Soome 
391a1bf3f78SToomas Soome 		i = 0;
392a1bf3f78SToomas Soome 		while ((status = read(fd, &ch, 1)) > 0 && ch != '\n')
393a1bf3f78SToomas Soome 			cp[i++] = ch;
394a1bf3f78SToomas Soome 		nLine++;
395a1bf3f78SToomas Soome 		if (!i) {
396a1bf3f78SToomas Soome 			if (status < 1)
397a1bf3f78SToomas Soome 				break;
398a1bf3f78SToomas Soome 			continue;
399a1bf3f78SToomas Soome 		}
400a1bf3f78SToomas Soome 		if (cp[i] == '\n')
401a1bf3f78SToomas Soome 			cp[i] = '\0';
402a1bf3f78SToomas Soome 
403a1bf3f78SToomas Soome 		FICL_STRING_SET_POINTER(s, cp);
404a1bf3f78SToomas Soome 		FICL_STRING_SET_LENGTH(s, i);
405a1bf3f78SToomas Soome 
406a1bf3f78SToomas Soome 		rval = ficlVmExecuteString(pVM, s);
407a1bf3f78SToomas Soome 		if (rval != FICL_VM_STATUS_QUIT &&
408a1bf3f78SToomas Soome 		    rval != FICL_VM_STATUS_USER_EXIT &&
409a1bf3f78SToomas Soome 		    rval != FICL_VM_STATUS_OUT_OF_TEXT) {
410a1bf3f78SToomas Soome 			pVM->sourceId = id;
411a1bf3f78SToomas Soome 			(void) ficlVmEvaluate(pVM, "");
412a1bf3f78SToomas Soome 			return (rval);
413a1bf3f78SToomas Soome 		}
414a1bf3f78SToomas Soome 	}
415a1bf3f78SToomas Soome 	pVM->sourceId = id;
416a1bf3f78SToomas Soome 
417a1bf3f78SToomas Soome 	/*
418a1bf3f78SToomas Soome 	 * Pass an empty line with SOURCE-ID == -1 to flush
419a1bf3f78SToomas Soome 	 * any pending REFILLs (as required by FILE wordset)
420a1bf3f78SToomas Soome 	 */
421a1bf3f78SToomas Soome 	(void) ficlVmEvaluate(pVM, "");
422a1bf3f78SToomas Soome 
423a1bf3f78SToomas Soome 	if (rval == FICL_VM_STATUS_USER_EXIT)
424a1bf3f78SToomas Soome 		ficlVmThrow(pVM, FICL_VM_STATUS_USER_EXIT);
425a1bf3f78SToomas Soome 
426a1bf3f78SToomas Soome 	return (rval);
427a1bf3f78SToomas Soome }
428a1bf3f78SToomas Soome 
429a1bf3f78SToomas Soome static void displayCellNoPad(ficlVm *pVM)
430a1bf3f78SToomas Soome {
431a1bf3f78SToomas Soome 	ficlCell c;
432a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
433a1bf3f78SToomas Soome 
434a1bf3f78SToomas Soome 	c = ficlStackPop(ficlVmGetDataStack(pVM));
435a1bf3f78SToomas Soome 	ficlLtoa((c).i, pVM->pad, pVM->base);
436a1bf3f78SToomas Soome 	ficlVmTextOut(pVM, pVM->pad);
437a1bf3f78SToomas Soome }
438a1bf3f78SToomas Soome 
439a1bf3f78SToomas Soome /*
440a1bf3f78SToomas Soome  * isdir? - Return whether an fd corresponds to a directory.
441a1bf3f78SToomas Soome  *
442a1bf3f78SToomas Soome  * isdir? ( fd -- bool )
443a1bf3f78SToomas Soome  */
444a1bf3f78SToomas Soome static void
445a1bf3f78SToomas Soome isdirQuestion(ficlVm *pVM)
446a1bf3f78SToomas Soome {
447a1bf3f78SToomas Soome 	struct stat sb;
448a1bf3f78SToomas Soome 	ficlInteger flag;
449a1bf3f78SToomas Soome 	int fd;
450a1bf3f78SToomas Soome 
451a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 1);
452a1bf3f78SToomas Soome 
453a1bf3f78SToomas Soome 	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
454a1bf3f78SToomas Soome 	flag = FICL_FALSE;
455a1bf3f78SToomas Soome 	do {
456a1bf3f78SToomas Soome 		if (fd < 0)
457a1bf3f78SToomas Soome 			break;
458a1bf3f78SToomas Soome 		if (fstat(fd, &sb) < 0)
459a1bf3f78SToomas Soome 			break;
460a1bf3f78SToomas Soome 		if (!S_ISDIR(sb.st_mode))
461a1bf3f78SToomas Soome 			break;
462a1bf3f78SToomas Soome 		flag = FICL_TRUE;
463a1bf3f78SToomas Soome 	} while (0);
464a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
465a1bf3f78SToomas Soome }
466a1bf3f78SToomas Soome 
467a1bf3f78SToomas Soome /*
468a1bf3f78SToomas Soome  * fopen - open a file and return new fd on stack.
469a1bf3f78SToomas Soome  *
470a1bf3f78SToomas Soome  * fopen ( ptr count mode -- fd )
471a1bf3f78SToomas Soome  */
472a1bf3f78SToomas Soome extern char *get_dev(const char *);
473a1bf3f78SToomas Soome 
474a1bf3f78SToomas Soome static void
475a1bf3f78SToomas Soome pfopen(ficlVm *pVM)
476a1bf3f78SToomas Soome {
477a1bf3f78SToomas Soome 	int mode, fd, count;
478a1bf3f78SToomas Soome 	char *ptr, *name;
479a1bf3f78SToomas Soome #ifndef STAND
480a1bf3f78SToomas Soome 	char *tmp;
481a1bf3f78SToomas Soome #endif
482a1bf3f78SToomas Soome 
483a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
484a1bf3f78SToomas Soome 
485a1bf3f78SToomas Soome 	mode = ficlStackPopInteger(ficlVmGetDataStack(pVM));	/* get mode */
486a1bf3f78SToomas Soome 	count = ficlStackPopInteger(ficlVmGetDataStack(pVM));	/* get count */
487a1bf3f78SToomas Soome 	ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM));	/* get ptr */
488a1bf3f78SToomas Soome 
489a1bf3f78SToomas Soome 	if ((count < 0) || (ptr == NULL)) {
490a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
491a1bf3f78SToomas Soome 		return;
492a1bf3f78SToomas Soome 	}
493a1bf3f78SToomas Soome 
494a1bf3f78SToomas Soome 	/* ensure that the string is null terminated */
495a1bf3f78SToomas Soome 	name = (char *)malloc(count+1);
496a1bf3f78SToomas Soome 	bcopy(ptr, name, count);
497a1bf3f78SToomas Soome 	name[count] = 0;
498a1bf3f78SToomas Soome #ifndef STAND
499a1bf3f78SToomas Soome 	tmp = get_dev(name);
500a1bf3f78SToomas Soome 	free(name);
501a1bf3f78SToomas Soome 	name = tmp;
502a1bf3f78SToomas Soome #endif
503a1bf3f78SToomas Soome 
504a1bf3f78SToomas Soome 	/* open the file */
505a1bf3f78SToomas Soome 	fd = open(name, mode);
506a1bf3f78SToomas Soome 	free(name);
507a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM), fd);
508a1bf3f78SToomas Soome }
509a1bf3f78SToomas Soome 
510a1bf3f78SToomas Soome /*
511a1bf3f78SToomas Soome  * fclose - close a file who's fd is on stack.
512a1bf3f78SToomas Soome  * fclose ( fd -- )
513a1bf3f78SToomas Soome  */
514a1bf3f78SToomas Soome static void
515a1bf3f78SToomas Soome pfclose(ficlVm *pVM)
516a1bf3f78SToomas Soome {
517a1bf3f78SToomas Soome 	int fd;
518a1bf3f78SToomas Soome 
519a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
520a1bf3f78SToomas Soome 
521a1bf3f78SToomas Soome 	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
522a1bf3f78SToomas Soome 	if (fd != -1)
523a1bf3f78SToomas Soome 		close(fd);
524a1bf3f78SToomas Soome }
525a1bf3f78SToomas Soome 
526a1bf3f78SToomas Soome /*
527a1bf3f78SToomas Soome  * fread - read file contents
528a1bf3f78SToomas Soome  * fread  ( fd buf nbytes  -- nread )
529a1bf3f78SToomas Soome  */
530a1bf3f78SToomas Soome static void
531a1bf3f78SToomas Soome pfread(ficlVm *pVM)
532a1bf3f78SToomas Soome {
533a1bf3f78SToomas Soome 	int fd, len;
534a1bf3f78SToomas Soome 	char *buf;
535a1bf3f78SToomas Soome 
536a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
537a1bf3f78SToomas Soome 
538a1bf3f78SToomas Soome 	len = ficlStackPopInteger(ficlVmGetDataStack(pVM));
539a1bf3f78SToomas Soome 	buf = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get buffer */
540a1bf3f78SToomas Soome 	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
541a1bf3f78SToomas Soome 	if (len > 0 && buf && fd != -1)
542a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM),
543a1bf3f78SToomas Soome 		    read(fd, buf, len));
544a1bf3f78SToomas Soome 	else
545a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
546a1bf3f78SToomas Soome }
547a1bf3f78SToomas Soome 
548a1bf3f78SToomas Soome /*
549a1bf3f78SToomas Soome  * fopendir - open directory
550a1bf3f78SToomas Soome  *
551a1bf3f78SToomas Soome  * fopendir ( addr len -- ptr TRUE | FALSE )
552a1bf3f78SToomas Soome  */
553a1bf3f78SToomas Soome static void pfopendir(ficlVm *pVM)
554a1bf3f78SToomas Soome {
555a1bf3f78SToomas Soome #ifndef STAND
556a1bf3f78SToomas Soome 	DIR *dir;
557a1bf3f78SToomas Soome 	char *tmp;
558a1bf3f78SToomas Soome #else
559a1bf3f78SToomas Soome 	struct stat sb;
560a1bf3f78SToomas Soome 	int fd;
561a1bf3f78SToomas Soome #endif
562a1bf3f78SToomas Soome 	int count;
563a1bf3f78SToomas Soome 	char *ptr, *name;
564a1bf3f78SToomas Soome 	ficlInteger flag = FICL_FALSE;
565a1bf3f78SToomas Soome 
566a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 1);
567a1bf3f78SToomas Soome 
568a1bf3f78SToomas Soome 	count = ficlStackPopInteger(ficlVmGetDataStack(pVM));
569a1bf3f78SToomas Soome 	ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM));	/* get ptr */
570a1bf3f78SToomas Soome 
571a1bf3f78SToomas Soome 	if ((count < 0) || (ptr == NULL)) {
572a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
573a1bf3f78SToomas Soome 		return;
574a1bf3f78SToomas Soome 	}
575a1bf3f78SToomas Soome 	/* ensure that the string is null terminated */
576a1bf3f78SToomas Soome 	name = (char *)malloc(count+1);
577a1bf3f78SToomas Soome 	bcopy(ptr, name, count);
578a1bf3f78SToomas Soome 	name[count] = 0;
579a1bf3f78SToomas Soome #ifndef STAND
580a1bf3f78SToomas Soome 	tmp = get_dev(name);
581a1bf3f78SToomas Soome 	free(name);
582a1bf3f78SToomas Soome 	name = tmp;
583a1bf3f78SToomas Soome #else
584a1bf3f78SToomas Soome 	fd = open(name, O_RDONLY);
585a1bf3f78SToomas Soome 	free(name);
586a1bf3f78SToomas Soome 	do {
587a1bf3f78SToomas Soome 		if (fd < 0)
588a1bf3f78SToomas Soome 			break;
589a1bf3f78SToomas Soome 		if (fstat(fd, &sb) < 0)
590a1bf3f78SToomas Soome 			break;
591a1bf3f78SToomas Soome 		if (!S_ISDIR(sb.st_mode))
592a1bf3f78SToomas Soome 			break;
593a1bf3f78SToomas Soome 		flag = FICL_TRUE;
594a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), fd);
595a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
596a1bf3f78SToomas Soome 		return;
597a1bf3f78SToomas Soome 	} while (0);
598a1bf3f78SToomas Soome 
599a1bf3f78SToomas Soome 	if (fd >= 0)
600a1bf3f78SToomas Soome 		close(fd);
601a1bf3f78SToomas Soome 
602a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
603a1bf3f78SToomas Soome 		return;
604a1bf3f78SToomas Soome #endif
605a1bf3f78SToomas Soome #ifndef STAND
606a1bf3f78SToomas Soome 	dir = opendir(name);
607a1bf3f78SToomas Soome 	if (dir == NULL) {
608a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
609a1bf3f78SToomas Soome 		return;
610a1bf3f78SToomas Soome 	} else
611a1bf3f78SToomas Soome 		flag = FICL_TRUE;
612a1bf3f78SToomas Soome 
613a1bf3f78SToomas Soome 	ficlStackPushPointer(ficlVmGetDataStack(pVM), dir);
614a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
615a1bf3f78SToomas Soome #endif
616a1bf3f78SToomas Soome }
617a1bf3f78SToomas Soome 
618a1bf3f78SToomas Soome /*
619a1bf3f78SToomas Soome  * freaddir - read directory contents
620a1bf3f78SToomas Soome  * freaddir ( fd -- ptr len TRUE | FALSE )
621a1bf3f78SToomas Soome  */
622a1bf3f78SToomas Soome static void
623a1bf3f78SToomas Soome pfreaddir(ficlVm *pVM)
624a1bf3f78SToomas Soome {
625a1bf3f78SToomas Soome #ifndef STAND
626a1bf3f78SToomas Soome 	static DIR *dir = NULL;
627a1bf3f78SToomas Soome #else
628a1bf3f78SToomas Soome 	int fd;
629a1bf3f78SToomas Soome #endif
630a1bf3f78SToomas Soome 	struct dirent *d = NULL;
631a1bf3f78SToomas Soome 
632a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 3);
633a1bf3f78SToomas Soome 	/*
634a1bf3f78SToomas Soome 	 * libstand readdir does not always return . nor .. so filter
635a1bf3f78SToomas Soome 	 * them out to have consistent behaviour.
636a1bf3f78SToomas Soome 	 */
637a1bf3f78SToomas Soome #ifndef STAND
638a1bf3f78SToomas Soome 	dir = ficlStackPopPointer(ficlVmGetDataStack(pVM));
639a1bf3f78SToomas Soome 	if (dir != NULL)
640a1bf3f78SToomas Soome 		do {
641a1bf3f78SToomas Soome 			d = readdir(dir);
642a1bf3f78SToomas Soome 			if (d != NULL && strcmp(d->d_name, ".") == 0)
643a1bf3f78SToomas Soome 				continue;
644a1bf3f78SToomas Soome 			if (d != NULL && strcmp(d->d_name, "..") == 0)
645a1bf3f78SToomas Soome 				continue;
646a1bf3f78SToomas Soome 			break;
647a1bf3f78SToomas Soome 		} while (d != NULL);
648a1bf3f78SToomas Soome #else
649a1bf3f78SToomas Soome 	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
650a1bf3f78SToomas Soome 	if (fd != -1)
651a1bf3f78SToomas Soome 		do {
652a1bf3f78SToomas Soome 			d = readdirfd(fd);
653a1bf3f78SToomas Soome 			if (d != NULL && strcmp(d->d_name, ".") == 0)
654a1bf3f78SToomas Soome 				continue;
655a1bf3f78SToomas Soome 			if (d != NULL && strcmp(d->d_name, "..") == 0)
656a1bf3f78SToomas Soome 				continue;
657a1bf3f78SToomas Soome 			break;
658a1bf3f78SToomas Soome 		} while (d != NULL);
659a1bf3f78SToomas Soome #endif
660a1bf3f78SToomas Soome 	if (d != NULL) {
661a1bf3f78SToomas Soome 		ficlStackPushPointer(ficlVmGetDataStack(pVM), d->d_name);
662a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM),
663a1bf3f78SToomas Soome 		    strlen(d->d_name));
664a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), FICL_TRUE);
665a1bf3f78SToomas Soome 	} else {
666a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), FICL_FALSE);
667a1bf3f78SToomas Soome 	}
668a1bf3f78SToomas Soome }
669a1bf3f78SToomas Soome 
670a1bf3f78SToomas Soome /*
671a1bf3f78SToomas Soome  * fclosedir - close a dir on stack.
672a1bf3f78SToomas Soome  *
673a1bf3f78SToomas Soome  * fclosedir ( fd -- )
674a1bf3f78SToomas Soome  */
675a1bf3f78SToomas Soome static void
676a1bf3f78SToomas Soome pfclosedir(ficlVm *pVM)
677a1bf3f78SToomas Soome {
678a1bf3f78SToomas Soome #ifndef STAND
679a1bf3f78SToomas Soome 	DIR *dir;
680a1bf3f78SToomas Soome #else
681a1bf3f78SToomas Soome 	int fd;
682a1bf3f78SToomas Soome #endif
683a1bf3f78SToomas Soome 
684a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
685a1bf3f78SToomas Soome 
686a1bf3f78SToomas Soome #ifndef STAND
687a1bf3f78SToomas Soome 	dir = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get dir */
688a1bf3f78SToomas Soome 	if (dir != NULL)
689a1bf3f78SToomas Soome 		closedir(dir);
690a1bf3f78SToomas Soome #else
691a1bf3f78SToomas Soome 	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
692a1bf3f78SToomas Soome 	if (fd != -1)
693a1bf3f78SToomas Soome 		close(fd);
694a1bf3f78SToomas Soome #endif
695a1bf3f78SToomas Soome }
696a1bf3f78SToomas Soome 
697a1bf3f78SToomas Soome /*
698a1bf3f78SToomas Soome  * fload - interpret file contents
699a1bf3f78SToomas Soome  *
700a1bf3f78SToomas Soome  * fload  ( fd -- )
701a1bf3f78SToomas Soome  */
702a1bf3f78SToomas Soome static void pfload(ficlVm *pVM)
703a1bf3f78SToomas Soome {
704a1bf3f78SToomas Soome 	int fd;
705a1bf3f78SToomas Soome 
706a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
707a1bf3f78SToomas Soome 
708a1bf3f78SToomas Soome 	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
709a1bf3f78SToomas Soome 	if (fd != -1)
710a1bf3f78SToomas Soome 		ficlExecFD(pVM, fd);
711a1bf3f78SToomas Soome }
712a1bf3f78SToomas Soome 
713a1bf3f78SToomas Soome /*
714a1bf3f78SToomas Soome  * fwrite - write file contents
715a1bf3f78SToomas Soome  *
716a1bf3f78SToomas Soome  * fwrite  ( fd buf nbytes  -- nwritten )
717a1bf3f78SToomas Soome  */
718a1bf3f78SToomas Soome static void
719a1bf3f78SToomas Soome pfwrite(ficlVm *pVM)
720a1bf3f78SToomas Soome {
721a1bf3f78SToomas Soome 	int fd, len;
722a1bf3f78SToomas Soome 	char *buf;
723a1bf3f78SToomas Soome 
724a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
725a1bf3f78SToomas Soome 
726a1bf3f78SToomas Soome 	len = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* bytes to read */
727a1bf3f78SToomas Soome 	buf = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get buffer */
728a1bf3f78SToomas Soome 	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
729a1bf3f78SToomas Soome 	if (len > 0 && buf && fd != -1)
730a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM),
731a1bf3f78SToomas Soome 		    write(fd, buf, len));
732a1bf3f78SToomas Soome 	else
733a1bf3f78SToomas Soome 		ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
734a1bf3f78SToomas Soome }
735a1bf3f78SToomas Soome 
736a1bf3f78SToomas Soome /*
737a1bf3f78SToomas Soome  * fseek - seek to a new position in a file
738a1bf3f78SToomas Soome  *
739a1bf3f78SToomas Soome  * fseek  ( fd ofs whence  -- pos )
740a1bf3f78SToomas Soome  */
741a1bf3f78SToomas Soome static void
742a1bf3f78SToomas Soome pfseek(ficlVm *pVM)
743a1bf3f78SToomas Soome {
744a1bf3f78SToomas Soome 	int fd, pos, whence;
745a1bf3f78SToomas Soome 
746a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
747a1bf3f78SToomas Soome 
748a1bf3f78SToomas Soome 	whence = ficlStackPopInteger(ficlVmGetDataStack(pVM));
749a1bf3f78SToomas Soome 	pos = ficlStackPopInteger(ficlVmGetDataStack(pVM));
750a1bf3f78SToomas Soome 	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
751a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM), lseek(fd, pos, whence));
752a1bf3f78SToomas Soome }
753a1bf3f78SToomas Soome 
754a1bf3f78SToomas Soome /*
755a1bf3f78SToomas Soome  * key - get a character from stdin
756a1bf3f78SToomas Soome  *
757a1bf3f78SToomas Soome  * key ( -- char )
758a1bf3f78SToomas Soome  */
759a1bf3f78SToomas Soome static void
760a1bf3f78SToomas Soome key(ficlVm *pVM)
761a1bf3f78SToomas Soome {
762a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
763a1bf3f78SToomas Soome 
764a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM), getchar());
765a1bf3f78SToomas Soome }
766a1bf3f78SToomas Soome 
767a1bf3f78SToomas Soome /*
768a1bf3f78SToomas Soome  * key? - check for a character from stdin (FACILITY)
769a1bf3f78SToomas Soome  * key? ( -- flag )
770a1bf3f78SToomas Soome  */
771a1bf3f78SToomas Soome static void
772a1bf3f78SToomas Soome keyQuestion(ficlVm *pVM)
773a1bf3f78SToomas Soome {
774a1bf3f78SToomas Soome #ifndef STAND
775a1bf3f78SToomas Soome 	char ch = -1;
776a1bf3f78SToomas Soome 	struct termios oldt;
777a1bf3f78SToomas Soome 	struct termios newt;
778a1bf3f78SToomas Soome #endif
779a1bf3f78SToomas Soome 
780a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
781a1bf3f78SToomas Soome 
782a1bf3f78SToomas Soome #ifndef STAND
783a1bf3f78SToomas Soome 	tcgetattr(STDIN_FILENO, &oldt);
784a1bf3f78SToomas Soome 	newt = oldt;
785a1bf3f78SToomas Soome 	newt.c_lflag &= ~(ICANON | ECHO);
786a1bf3f78SToomas Soome 	newt.c_cc[VMIN] = 0;
787a1bf3f78SToomas Soome 	newt.c_cc[VTIME] = 0;
788a1bf3f78SToomas Soome 	tcsetattr(STDIN_FILENO, TCSANOW, &newt);
789a1bf3f78SToomas Soome 	ch = getchar();
790a1bf3f78SToomas Soome 	tcsetattr(STDIN_FILENO, TCSANOW, &oldt);
791a1bf3f78SToomas Soome 
792a1bf3f78SToomas Soome 	if (ch != -1)
793a1bf3f78SToomas Soome 		(void) ungetc(ch, stdin);
794a1bf3f78SToomas Soome 
795a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM),
796a1bf3f78SToomas Soome 	    ch != -1? FICL_TRUE : FICL_FALSE);
797a1bf3f78SToomas Soome #else
798a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM),
799a1bf3f78SToomas Soome 	    ischar()? FICL_TRUE : FICL_FALSE);
800a1bf3f78SToomas Soome #endif
801a1bf3f78SToomas Soome }
802a1bf3f78SToomas Soome 
803a1bf3f78SToomas Soome /*
804a1bf3f78SToomas Soome  * seconds - gives number of seconds since beginning of time
805a1bf3f78SToomas Soome  *
806a1bf3f78SToomas Soome  * beginning of time is defined as:
807a1bf3f78SToomas Soome  *
808a1bf3f78SToomas Soome  *	BTX	- number of seconds since midnight
809a1bf3f78SToomas Soome  *	FreeBSD	- number of seconds since Jan 1 1970
810a1bf3f78SToomas Soome  *
811a1bf3f78SToomas Soome  * seconds ( -- u )
812a1bf3f78SToomas Soome  */
813a1bf3f78SToomas Soome static void
814a1bf3f78SToomas Soome pseconds(ficlVm *pVM)
815a1bf3f78SToomas Soome {
816a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
817a1bf3f78SToomas Soome 
818a1bf3f78SToomas Soome 	ficlStackPushUnsigned(ficlVmGetDataStack(pVM),
819a1bf3f78SToomas Soome 	    (ficlUnsigned) time(NULL));
820a1bf3f78SToomas Soome }
821a1bf3f78SToomas Soome 
822a1bf3f78SToomas Soome /*
823a1bf3f78SToomas Soome  * ms - wait at least that many milliseconds (FACILITY)
824a1bf3f78SToomas Soome  * ms ( u -- )
825a1bf3f78SToomas Soome  */
826a1bf3f78SToomas Soome static void
827a1bf3f78SToomas Soome ms(ficlVm *pVM)
828a1bf3f78SToomas Soome {
829a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
830a1bf3f78SToomas Soome 
831a1bf3f78SToomas Soome #ifndef STAND
832a1bf3f78SToomas Soome 	usleep(ficlStackPopUnsigned(ficlVmGetDataStack(pVM)) * 1000);
833a1bf3f78SToomas Soome #else
834a1bf3f78SToomas Soome 	delay(ficlStackPopUnsigned(ficlVmGetDataStack(pVM)) * 1000);
835a1bf3f78SToomas Soome #endif
836a1bf3f78SToomas Soome }
837a1bf3f78SToomas Soome 
838a1bf3f78SToomas Soome /*
839a1bf3f78SToomas Soome  * fkey - get a character from a file
840a1bf3f78SToomas Soome  * fkey ( file -- char )
841a1bf3f78SToomas Soome  */
842a1bf3f78SToomas Soome static void
843a1bf3f78SToomas Soome fkey(ficlVm *pVM)
844a1bf3f78SToomas Soome {
845a1bf3f78SToomas Soome 	int i, fd;
846a1bf3f78SToomas Soome 	char ch;
847a1bf3f78SToomas Soome 
848a1bf3f78SToomas Soome 	FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 1);
849a1bf3f78SToomas Soome 
850a1bf3f78SToomas Soome 	fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
851a1bf3f78SToomas Soome 	i = read(fd, &ch, 1);
852a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM), i > 0 ? ch : -1);
853a1bf3f78SToomas Soome }
854a1bf3f78SToomas Soome 
855a1bf3f78SToomas Soome 
856a1bf3f78SToomas Soome #ifdef STAND
857a1bf3f78SToomas Soome #ifdef __i386__
858a1bf3f78SToomas Soome 
859a1bf3f78SToomas Soome /*
860a1bf3f78SToomas Soome  * outb ( port# c -- )
861a1bf3f78SToomas Soome  * Store a byte to I/O port number port#
862a1bf3f78SToomas Soome  */
863a1bf3f78SToomas Soome void
864a1bf3f78SToomas Soome ficlOutb(ficlVm *pVM)
865a1bf3f78SToomas Soome {
866a1bf3f78SToomas Soome 	uint8_t c;
867a1bf3f78SToomas Soome 	uint32_t port;
868a1bf3f78SToomas Soome 
869a1bf3f78SToomas Soome 	port = ficlStackPopUnsigned(ficlVmGetDataStack(pVM));
870a1bf3f78SToomas Soome 	c = ficlStackPopInteger(ficlVmGetDataStack(pVM));
871a1bf3f78SToomas Soome 	outb(port, c);
872a1bf3f78SToomas Soome }
873a1bf3f78SToomas Soome 
874a1bf3f78SToomas Soome /*
875a1bf3f78SToomas Soome  * inb ( port# -- c )
876a1bf3f78SToomas Soome  * Fetch a byte from I/O port number port#
877a1bf3f78SToomas Soome  */
878a1bf3f78SToomas Soome void
879a1bf3f78SToomas Soome ficlInb(ficlVm *pVM)
880a1bf3f78SToomas Soome {
881a1bf3f78SToomas Soome 	uint8_t c;
882a1bf3f78SToomas Soome 	uint32_t port;
883a1bf3f78SToomas Soome 
884a1bf3f78SToomas Soome 	port = ficlStackPopUnsigned(ficlVmGetDataStack(pVM));
885a1bf3f78SToomas Soome 	c = inb(port);
886a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM), c);
887a1bf3f78SToomas Soome }
888a1bf3f78SToomas Soome #endif
889a1bf3f78SToomas Soome #endif
890a1bf3f78SToomas Soome 
891a1bf3f78SToomas Soome /*
892a1bf3f78SToomas Soome  * Retrieves free space remaining on the dictionary
893a1bf3f78SToomas Soome  */
894a1bf3f78SToomas Soome static void
895a1bf3f78SToomas Soome freeHeap(ficlVm *pVM)
896a1bf3f78SToomas Soome {
897a1bf3f78SToomas Soome 	ficlStackPushInteger(ficlVmGetDataStack(pVM),
898a1bf3f78SToomas Soome 	    ficlDictionaryCellsAvailable(ficlVmGetDictionary(pVM)));
899a1bf3f78SToomas Soome }
900a1bf3f78SToomas Soome 
901a1bf3f78SToomas Soome /*
902a1bf3f78SToomas Soome  * f i c l C o m p i l e P l a t f o r m
903a1bf3f78SToomas Soome  * Build FreeBSD platform extensions into the system dictionary
904a1bf3f78SToomas Soome  */
905a1bf3f78SToomas Soome void
906a1bf3f78SToomas Soome ficlSystemCompilePlatform(ficlSystem *pSys)
907a1bf3f78SToomas Soome {
908a1bf3f78SToomas Soome 	ficlDictionary *dp = ficlSystemGetDictionary(pSys);
909a1bf3f78SToomas Soome 	ficlDictionary *env = ficlSystemGetEnvironment(pSys);
910*d5a0772bSToomas Soome #ifdef STAND
911*d5a0772bSToomas Soome 	ficlCompileFcn **fnpp;
912*d5a0772bSToomas Soome #endif
913a1bf3f78SToomas Soome 
914a1bf3f78SToomas Soome 	FICL_SYSTEM_ASSERT(pSys, dp);
915a1bf3f78SToomas Soome 	FICL_SYSTEM_ASSERT(pSys, env);
916a1bf3f78SToomas Soome 
917a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, ".#", displayCellNoPad,
918a1bf3f78SToomas Soome 	    FICL_WORD_DEFAULT);
919a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "isdir?", isdirQuestion,
920a1bf3f78SToomas Soome 	    FICL_WORD_DEFAULT);
921a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "fopen", pfopen, FICL_WORD_DEFAULT);
922a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "fclose", pfclose, FICL_WORD_DEFAULT);
923a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "fread", pfread, FICL_WORD_DEFAULT);
924a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "fopendir", pfopendir,
925a1bf3f78SToomas Soome 	    FICL_WORD_DEFAULT);
926a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "freaddir", pfreaddir,
927a1bf3f78SToomas Soome 	    FICL_WORD_DEFAULT);
928a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "fclosedir", pfclosedir,
929a1bf3f78SToomas Soome 	    FICL_WORD_DEFAULT);
930a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "fload", pfload, FICL_WORD_DEFAULT);
931a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "fkey", fkey, FICL_WORD_DEFAULT);
932a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "fseek", pfseek, FICL_WORD_DEFAULT);
933a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "fwrite", pfwrite, FICL_WORD_DEFAULT);
934a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "key", key, FICL_WORD_DEFAULT);
935a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "key?", keyQuestion, FICL_WORD_DEFAULT);
936a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "ms", ms, FICL_WORD_DEFAULT);
937a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "seconds", pseconds, FICL_WORD_DEFAULT);
938a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "heap?", freeHeap, FICL_WORD_DEFAULT);
939a1bf3f78SToomas Soome 
940a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "setenv", ficlSetenv, FICL_WORD_DEFAULT);
941a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "setenv?", ficlSetenvq,
942a1bf3f78SToomas Soome 	    FICL_WORD_DEFAULT);
943a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "getenv", ficlGetenv, FICL_WORD_DEFAULT);
944a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "unsetenv", ficlUnsetenv,
945a1bf3f78SToomas Soome 	    FICL_WORD_DEFAULT);
946a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "copyin", ficlCopyin, FICL_WORD_DEFAULT);
947a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "copyout", ficlCopyout,
948a1bf3f78SToomas Soome 	    FICL_WORD_DEFAULT);
949a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "findfile", ficlFindfile,
950a1bf3f78SToomas Soome 	    FICL_WORD_DEFAULT);
951a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "ccall", ficlCcall, FICL_WORD_DEFAULT);
952065446baSToomas Soome 	ficlDictionarySetPrimitive(dp, "uuid-from-string", ficlUuidFromString,
953065446baSToomas Soome 	    FICL_WORD_DEFAULT);
954065446baSToomas Soome 	ficlDictionarySetPrimitive(dp, "uuid-to-string", ficlUuidToString,
955065446baSToomas Soome 	    FICL_WORD_DEFAULT);
956a1bf3f78SToomas Soome #ifdef STAND
957a1bf3f78SToomas Soome #ifdef __i386__
958a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "outb", ficlOutb, FICL_WORD_DEFAULT);
959a1bf3f78SToomas Soome 	ficlDictionarySetPrimitive(dp, "inb", ficlInb, FICL_WORD_DEFAULT);
960a1bf3f78SToomas Soome #endif
961*d5a0772bSToomas Soome 	/* Register words from linker set. */
962*d5a0772bSToomas Soome 	SET_FOREACH(fnpp, Xficl_compile_set)
963*d5a0772bSToomas Soome 		(*fnpp)(pSys);
964a1bf3f78SToomas Soome #endif
965a1bf3f78SToomas Soome 
966a1bf3f78SToomas Soome #if defined(__i386__) || defined(__amd64__)
967a1bf3f78SToomas Soome 	ficlDictionarySetConstant(env, "arch-i386", FICL_TRUE);
968a1bf3f78SToomas Soome 	ficlDictionarySetConstant(env, "arch-sparc", FICL_FALSE);
969a1bf3f78SToomas Soome #endif
970a1bf3f78SToomas Soome #ifdef __sparc
971a1bf3f78SToomas Soome 	ficlDictionarySetConstant(env, "arch-i386", FICL_FALSE);
972a1bf3f78SToomas Soome 	ficlDictionarySetConstant(env, "arch-sparc", FICL_TRUE);
973a1bf3f78SToomas Soome #endif
974a1bf3f78SToomas Soome }
975