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