xref: /freebsd/stand/ficl/loader.c (revision 6966ac055c3b7a39266fb982493330df7a097997) 
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 
35 #ifdef TESTMAIN
36 #include <sys/types.h>
37 #include <sys/stat.h>
38 #include <dirent.h>
39 #include <fcntl.h>
40 #include <stdio.h>
41 #include <stdlib.h>
42 #include <unistd.h>
43 #else
44 #include <stand.h>
45 #endif
46 #include "bootstrap.h"
47 #include <string.h>
48 #include <uuid.h>
49 #include "ficl.h"
50 
51 /*		FreeBSD's loader interaction words and extras
52  *
53  * 		setenv      ( value n name n' -- )
54  * 		setenv?     ( value n name n' flag -- )
55  * 		getenv      ( addr n -- addr' n' | -1 )
56  * 		unsetenv    ( addr n -- )
57  * 		copyin      ( addr addr' len -- )
58  * 		copyout     ( addr addr' len -- )
59  * 		findfile    ( name len type len' -- addr )
60  * 		pnpdevices  ( -- addr )
61  * 		pnphandlers ( -- addr )
62  * 		ccall       ( [[...[p10] p9] ... p1] n addr -- result )
63  *		uuid-from-string ( addr n -- addr' )
64  *		uuid-to-string ( addr' -- addr n )
65  * 		.#	    ( value -- )
66  */
67 
68 void
69 ficlSetenv(FICL_VM *pVM)
70 {
71 #ifndef TESTMAIN
72 	char	*name, *value;
73 #endif
74 	char	*namep, *valuep;
75 	int	names, values;
76 
77 #if FICL_ROBUST > 1
78 	vmCheckStack(pVM, 4, 0);
79 #endif
80 	names = stackPopINT(pVM->pStack);
81 	namep = (char*) stackPopPtr(pVM->pStack);
82 	values = stackPopINT(pVM->pStack);
83 	valuep = (char*) stackPopPtr(pVM->pStack);
84 
85 #ifndef TESTMAIN
86 	name = (char*) ficlMalloc(names+1);
87 	if (!name)
88 		vmThrowErr(pVM, "Error: out of memory");
89 	strncpy(name, namep, names);
90 	name[names] = '\0';
91 	value = (char*) ficlMalloc(values+1);
92 	if (!value)
93 		vmThrowErr(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 #endif
101 
102 	return;
103 }
104 
105 void
106 ficlSetenvq(FICL_VM *pVM)
107 {
108 #ifndef TESTMAIN
109 	char	*name, *value;
110 #endif
111 	char	*namep, *valuep;
112 	int	names, values, overwrite;
113 
114 #if FICL_ROBUST > 1
115 	vmCheckStack(pVM, 5, 0);
116 #endif
117 	overwrite = stackPopINT(pVM->pStack);
118 	names = stackPopINT(pVM->pStack);
119 	namep = (char*) stackPopPtr(pVM->pStack);
120 	values = stackPopINT(pVM->pStack);
121 	valuep = (char*) stackPopPtr(pVM->pStack);
122 
123 #ifndef TESTMAIN
124 	name = (char*) ficlMalloc(names+1);
125 	if (!name)
126 		vmThrowErr(pVM, "Error: out of memory");
127 	strncpy(name, namep, names);
128 	name[names] = '\0';
129 	value = (char*) ficlMalloc(values+1);
130 	if (!value)
131 		vmThrowErr(pVM, "Error: out of memory");
132 	strncpy(value, valuep, values);
133 	value[values] = '\0';
134 
135 	setenv(name, value, overwrite);
136 	ficlFree(name);
137 	ficlFree(value);
138 #endif
139 
140 	return;
141 }
142 
143 void
144 ficlGetenv(FICL_VM *pVM)
145 {
146 #ifndef TESTMAIN
147 	char	*name, *value;
148 #endif
149 	char	*namep;
150 	int	names;
151 
152 #if FICL_ROBUST > 1
153 	vmCheckStack(pVM, 2, 2);
154 #endif
155 	names = stackPopINT(pVM->pStack);
156 	namep = (char*) stackPopPtr(pVM->pStack);
157 
158 #ifndef TESTMAIN
159 	name = (char*) ficlMalloc(names+1);
160 	if (!name)
161 		vmThrowErr(pVM, "Error: out of memory");
162 	strncpy(name, namep, names);
163 	name[names] = '\0';
164 
165 	value = getenv(name);
166 	ficlFree(name);
167 
168 	if(value != NULL) {
169 		stackPushPtr(pVM->pStack, value);
170 		stackPushINT(pVM->pStack, strlen(value));
171 	} else
172 #endif
173 		stackPushINT(pVM->pStack, -1);
174 
175 	return;
176 }
177 
178 void
179 ficlUnsetenv(FICL_VM *pVM)
180 {
181 #ifndef TESTMAIN
182 	char	*name;
183 #endif
184 	char	*namep;
185 	int	names;
186 
187 #if FICL_ROBUST > 1
188 	vmCheckStack(pVM, 2, 0);
189 #endif
190 	names = stackPopINT(pVM->pStack);
191 	namep = (char*) stackPopPtr(pVM->pStack);
192 
193 #ifndef TESTMAIN
194 	name = (char*) ficlMalloc(names+1);
195 	if (!name)
196 		vmThrowErr(pVM, "Error: out of memory");
197 	strncpy(name, namep, names);
198 	name[names] = '\0';
199 
200 	unsetenv(name);
201 	ficlFree(name);
202 #endif
203 
204 	return;
205 }
206 
207 void
208 ficlCopyin(FICL_VM *pVM)
209 {
210 	void*		src;
211 	vm_offset_t	dest;
212 	size_t		len;
213 
214 #if FICL_ROBUST > 1
215 	vmCheckStack(pVM, 3, 0);
216 #endif
217 
218 	len = stackPopINT(pVM->pStack);
219 	dest = stackPopINT(pVM->pStack);
220 	src = stackPopPtr(pVM->pStack);
221 
222 #ifndef TESTMAIN
223 	archsw.arch_copyin(src, dest, len);
224 #endif
225 
226 	return;
227 }
228 
229 void
230 ficlCopyout(FICL_VM *pVM)
231 {
232 	void*		dest;
233 	vm_offset_t	src;
234 	size_t		len;
235 
236 #if FICL_ROBUST > 1
237 	vmCheckStack(pVM, 3, 0);
238 #endif
239 
240 	len = stackPopINT(pVM->pStack);
241 	dest = stackPopPtr(pVM->pStack);
242 	src = stackPopINT(pVM->pStack);
243 
244 #ifndef TESTMAIN
245 	archsw.arch_copyout(src, dest, len);
246 #endif
247 
248 	return;
249 }
250 
251 void
252 ficlFindfile(FICL_VM *pVM)
253 {
254 #ifndef TESTMAIN
255 	char	*name, *type;
256 #endif
257 	char	*namep, *typep;
258 	struct	preloaded_file* fp;
259 	int	names, types;
260 
261 #if FICL_ROBUST > 1
262 	vmCheckStack(pVM, 4, 1);
263 #endif
264 
265 	types = stackPopINT(pVM->pStack);
266 	typep = (char*) stackPopPtr(pVM->pStack);
267 	names = stackPopINT(pVM->pStack);
268 	namep = (char*) stackPopPtr(pVM->pStack);
269 #ifndef TESTMAIN
270 	name = (char*) ficlMalloc(names+1);
271 	if (!name)
272 		vmThrowErr(pVM, "Error: out of memory");
273 	strncpy(name, namep, names);
274 	name[names] = '\0';
275 	type = (char*) ficlMalloc(types+1);
276 	if (!type)
277 		vmThrowErr(pVM, "Error: out of memory");
278 	strncpy(type, typep, types);
279 	type[types] = '\0';
280 
281 	fp = file_findfile(name, type);
282 #else
283 	fp = NULL;
284 #endif
285 	stackPushPtr(pVM->pStack, fp);
286 
287 	return;
288 }
289 
290 #ifndef TESTMAIN
291 
292 /*	isvirtualized? - Return whether the loader runs under a
293  *			hypervisor.
294  *
295  * isvirtualized? ( -- flag )
296  */
297 static void
298 ficlIsvirtualizedQ(FICL_VM *pVM)
299 {
300 	FICL_INT flag;
301 	const char *hv;
302 
303 #if FICL_ROBUST > 1
304 	vmCheckStack(pVM, 0, 1);
305 #endif
306 
307 	hv = (archsw.arch_hypervisor != NULL)
308 	    ? (*archsw.arch_hypervisor)()
309 	    : NULL;
310 	flag = (hv != NULL) ? FICL_TRUE : FICL_FALSE;
311 	stackPushINT(pVM->pStack, flag);
312 }
313 
314 #endif /* ndef TESTMAIN */
315 
316 void
317 ficlCcall(FICL_VM *pVM)
318 {
319 	int (*func)(int, ...);
320 	int result, p[10];
321 	int nparam, i;
322 
323 #if FICL_ROBUST > 1
324 	vmCheckStack(pVM, 2, 0);
325 #endif
326 
327 	func = stackPopPtr(pVM->pStack);
328 	nparam = stackPopINT(pVM->pStack);
329 
330 #if FICL_ROBUST > 1
331 	vmCheckStack(pVM, nparam, 1);
332 #endif
333 
334 	for (i = 0; i < nparam; i++)
335 		p[i] = stackPopINT(pVM->pStack);
336 
337 	result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8],
338 	    p[9]);
339 
340 	stackPushINT(pVM->pStack, result);
341 
342 	return;
343 }
344 
345 void
346 ficlUuidFromString(FICL_VM *pVM)
347 {
348 #ifndef	TESTMAIN
349 	char	*uuid;
350 	uint32_t status;
351 #endif
352 	char	*uuidp;
353 	int	uuids;
354 	uuid_t	*u;
355 
356 #if FICL_ROBUST > 1
357 	vmCheckStack(pVM, 2, 0);
358 #endif
359 
360 	uuids = stackPopINT(pVM->pStack);
361 	uuidp = (char *) stackPopPtr(pVM->pStack);
362 
363 #ifndef	TESTMAIN
364 	uuid = (char *)ficlMalloc(uuids + 1);
365 	if (!uuid)
366 		vmThrowErr(pVM, "Error: out of memory");
367 	strncpy(uuid, uuidp, uuids);
368 	uuid[uuids] = '\0';
369 
370 	u = (uuid_t *)ficlMalloc(sizeof (*u));
371 
372 	uuid_from_string(uuid, u, &status);
373 	ficlFree(uuid);
374 	if (status != uuid_s_ok) {
375 		ficlFree(u);
376 		u = NULL;
377 	}
378 #else
379 	u = NULL;
380 #endif
381 	stackPushPtr(pVM->pStack, u);
382 
383 
384 	return;
385 }
386 
387 void
388 ficlUuidToString(FICL_VM *pVM)
389 {
390 #ifndef	TESTMAIN
391 	char	*uuid;
392 	uint32_t status;
393 #endif
394 	uuid_t	*u;
395 
396 #if FICL_ROBUST > 1
397 	vmCheckStack(pVM, 1, 0);
398 #endif
399 
400 	u = (uuid_t *)stackPopPtr(pVM->pStack);
401 
402 #ifndef	TESTMAIN
403 	uuid_to_string(u, &uuid, &status);
404 	if (status != uuid_s_ok) {
405 		stackPushPtr(pVM->pStack, uuid);
406 		stackPushINT(pVM->pStack, strlen(uuid));
407 	} else
408 #endif
409 		stackPushINT(pVM->pStack, -1);
410 
411 	return;
412 }
413 
414 /**************************************************************************
415                         f i c l E x e c F D
416 ** reads in text from file fd and passes it to ficlExec()
417  * returns VM_OUTOFTEXT on success or the ficlExec() error code on
418  * failure.
419  */
420 #define nLINEBUF 256
421 int ficlExecFD(FICL_VM *pVM, int fd)
422 {
423     char    cp[nLINEBUF];
424     int     nLine = 0, rval = VM_OUTOFTEXT;
425     char    ch;
426     CELL    id;
427 
428     id = pVM->sourceID;
429     pVM->sourceID.i = fd;
430 
431     /* feed each line to ficlExec */
432     while (1) {
433 	int status, i;
434 
435 	i = 0;
436 	while ((status = read(fd, &ch, 1)) > 0 && ch != '\n')
437 	    cp[i++] = ch;
438         nLine++;
439 	if (!i) {
440 	    if (status < 1)
441 		break;
442 	    continue;
443 	}
444         rval = ficlExecC(pVM, cp, i);
445 	if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT)
446         {
447             pVM->sourceID = id;
448             return rval;
449         }
450     }
451     /*
452     ** Pass an empty line with SOURCE-ID == -1 to flush
453     ** any pending REFILLs (as required by FILE wordset)
454     */
455     pVM->sourceID.i = -1;
456     ficlExec(pVM, "");
457 
458     pVM->sourceID = id;
459     return rval;
460 }
461 
462 static void displayCellNoPad(FICL_VM *pVM)
463 {
464     CELL c;
465 #if FICL_ROBUST > 1
466     vmCheckStack(pVM, 1, 0);
467 #endif
468     c = stackPop(pVM->pStack);
469     ltoa((c).i, pVM->pad, pVM->base);
470     vmTextOut(pVM, pVM->pad, 0);
471     return;
472 }
473 
474 /*      isdir? - Return whether an fd corresponds to a directory.
475  *
476  * isdir? ( fd -- bool )
477  */
478 static void isdirQuestion(FICL_VM *pVM)
479 {
480     struct stat sb;
481     FICL_INT flag;
482     int fd;
483 
484 #if FICL_ROBUST > 1
485     vmCheckStack(pVM, 1, 1);
486 #endif
487 
488     fd = stackPopINT(pVM->pStack);
489     flag = FICL_FALSE;
490     do {
491         if (fd < 0)
492             break;
493         if (fstat(fd, &sb) < 0)
494             break;
495         if (!S_ISDIR(sb.st_mode))
496             break;
497         flag = FICL_TRUE;
498     } while (0);
499     stackPushINT(pVM->pStack, flag);
500 }
501 
502 /*          fopen - open a file and return new fd on stack.
503  *
504  * fopen ( ptr count mode -- fd )
505  */
506 static void pfopen(FICL_VM *pVM)
507 {
508     int     mode, fd, count;
509     char    *ptr, *name;
510 
511 #if FICL_ROBUST > 1
512     vmCheckStack(pVM, 3, 1);
513 #endif
514 
515     mode = stackPopINT(pVM->pStack);    /* get mode */
516     count = stackPopINT(pVM->pStack);   /* get count */
517     ptr = stackPopPtr(pVM->pStack);     /* get ptr */
518 
519     if ((count < 0) || (ptr == NULL)) {
520         stackPushINT(pVM->pStack, -1);
521         return;
522     }
523 
524     /* ensure that the string is null terminated */
525     name = (char *)malloc(count+1);
526     bcopy(ptr,name,count);
527     name[count] = 0;
528 
529     /* open the file */
530     fd = open(name, mode);
531 #ifdef LOADER_VERIEXEC
532     if (fd >= 0) {
533 	if (verify_file(fd, name, 0, VE_GUESS) < 0) {
534 	    /* not verified writing ok but reading is not */
535 	    if ((mode & O_ACCMODE) != O_WRONLY) {
536 		close(fd);
537 		fd = -1;
538 	    }
539 	} else {
540 	    /* verified reading ok but writing is not */
541 	    if ((mode & O_ACCMODE) != O_RDONLY) {
542 		close(fd);
543 		fd = -1;
544 	    }
545 	}
546     }
547 #endif
548     free(name);
549     stackPushINT(pVM->pStack, fd);
550     return;
551 }
552 
553 /*          fclose - close a file who's fd is on stack.
554  *
555  * fclose ( fd -- )
556  */
557 static void pfclose(FICL_VM *pVM)
558 {
559     int fd;
560 
561 #if FICL_ROBUST > 1
562     vmCheckStack(pVM, 1, 0);
563 #endif
564     fd = stackPopINT(pVM->pStack); /* get fd */
565     if (fd != -1)
566 	close(fd);
567     return;
568 }
569 
570 /*          fread - read file contents
571  *
572  * fread  ( fd buf nbytes  -- nread )
573  */
574 static void pfread(FICL_VM *pVM)
575 {
576     int     fd, len;
577     char *buf;
578 
579 #if FICL_ROBUST > 1
580     vmCheckStack(pVM, 3, 1);
581 #endif
582     len = stackPopINT(pVM->pStack); /* get number of bytes to read */
583     buf = stackPopPtr(pVM->pStack); /* get buffer */
584     fd = stackPopINT(pVM->pStack); /* get fd */
585     if (len > 0 && buf && fd != -1)
586 	stackPushINT(pVM->pStack, read(fd, buf, len));
587     else
588 	stackPushINT(pVM->pStack, -1);
589     return;
590 }
591 
592 /*      freaddir - read directory contents
593  *
594  * freaddir ( fd -- ptr len TRUE | FALSE )
595  */
596 static void pfreaddir(FICL_VM *pVM)
597 {
598 #ifdef TESTMAIN
599     static struct dirent dirent;
600     struct stat sb;
601     char *buf;
602     off_t off, ptr;
603     u_int blksz;
604     int bufsz;
605 #endif
606     struct dirent *d;
607     int fd;
608 
609 #if FICL_ROBUST > 1
610     vmCheckStack(pVM, 1, 3);
611 #endif
612 
613     fd = stackPopINT(pVM->pStack);
614 #if TESTMAIN
615     /*
616      * The readdirfd() function is specific to the loader environment.
617      * We do the best we can to make freaddir work, but it's not at
618      * all guaranteed.
619      */
620     d = NULL;
621     buf = NULL;
622     do {
623 	if (fd == -1)
624 	    break;
625 	if (fstat(fd, &sb) == -1)
626 	    break;
627 	blksz = (sb.st_blksize) ? sb.st_blksize : getpagesize();
628 	if ((blksz & (blksz - 1)) != 0)
629 	    break;
630 	buf = malloc(blksz);
631 	if (buf == NULL)
632 	    break;
633 	off = lseek(fd, 0LL, SEEK_CUR);
634 	if (off == -1)
635 	    break;
636 	ptr = off;
637 	if (lseek(fd, 0, SEEK_SET) == -1)
638 	    break;
639 	bufsz = getdents(fd, buf, blksz);
640 	while (bufsz > 0 && bufsz <= ptr) {
641 	    ptr -= bufsz;
642 	    bufsz = getdents(fd, buf, blksz);
643 	}
644 	if (bufsz <= 0)
645 	    break;
646 	d = (void *)(buf + ptr);
647 	dirent = *d;
648 	off += d->d_reclen;
649 	d = (lseek(fd, off, SEEK_SET) != off) ? NULL : &dirent;
650     } while (0);
651     if (buf != NULL)
652 	free(buf);
653 #else
654     d = readdirfd(fd);
655 #endif
656     if (d != NULL) {
657         stackPushPtr(pVM->pStack, d->d_name);
658         stackPushINT(pVM->pStack, strlen(d->d_name));
659         stackPushINT(pVM->pStack, FICL_TRUE);
660     } else {
661         stackPushINT(pVM->pStack, FICL_FALSE);
662     }
663 }
664 
665 /*          fload - interpret file contents
666  *
667  * fload  ( fd -- )
668  */
669 static void pfload(FICL_VM *pVM)
670 {
671     int     fd;
672 
673 #if FICL_ROBUST > 1
674     vmCheckStack(pVM, 1, 0);
675 #endif
676     fd = stackPopINT(pVM->pStack); /* get fd */
677     if (fd != -1)
678 	ficlExecFD(pVM, fd);
679     return;
680 }
681 
682 /*          fwrite - write file contents
683  *
684  * fwrite  ( fd buf nbytes  -- nwritten )
685  */
686 static void pfwrite(FICL_VM *pVM)
687 {
688     int     fd, len;
689     char *buf;
690 
691 #if FICL_ROBUST > 1
692     vmCheckStack(pVM, 3, 1);
693 #endif
694     len = stackPopINT(pVM->pStack); /* get number of bytes to read */
695     buf = stackPopPtr(pVM->pStack); /* get buffer */
696     fd = stackPopINT(pVM->pStack); /* get fd */
697     if (len > 0 && buf && fd != -1)
698 	stackPushINT(pVM->pStack, write(fd, buf, len));
699     else
700 	stackPushINT(pVM->pStack, -1);
701     return;
702 }
703 
704 /*          fseek - seek to a new position in a file
705  *
706  * fseek  ( fd ofs whence  -- pos )
707  */
708 static void pfseek(FICL_VM *pVM)
709 {
710     int     fd, pos, whence;
711 
712 #if FICL_ROBUST > 1
713     vmCheckStack(pVM, 3, 1);
714 #endif
715     whence = stackPopINT(pVM->pStack);
716     pos = stackPopINT(pVM->pStack);
717     fd = stackPopINT(pVM->pStack);
718     stackPushINT(pVM->pStack, lseek(fd, pos, whence));
719     return;
720 }
721 
722 /*           key - get a character from stdin
723  *
724  * key ( -- char )
725  */
726 static void key(FICL_VM *pVM)
727 {
728 #if FICL_ROBUST > 1
729     vmCheckStack(pVM, 0, 1);
730 #endif
731     stackPushINT(pVM->pStack, getchar());
732     return;
733 }
734 
735 /*           key? - check for a character from stdin (FACILITY)
736  *
737  * key? ( -- flag )
738  */
739 static void keyQuestion(FICL_VM *pVM)
740 {
741 #if FICL_ROBUST > 1
742     vmCheckStack(pVM, 0, 1);
743 #endif
744 #ifdef TESTMAIN
745     /* XXX Since we don't fiddle with termios, let it always succeed... */
746     stackPushINT(pVM->pStack, FICL_TRUE);
747 #else
748     /* But here do the right thing. */
749     stackPushINT(pVM->pStack, ischar()? FICL_TRUE : FICL_FALSE);
750 #endif
751     return;
752 }
753 
754 /* seconds - gives number of seconds since beginning of time
755  *
756  * beginning of time is defined as:
757  *
758  *	BTX	- number of seconds since midnight
759  *	FreeBSD	- number of seconds since Jan 1 1970
760  *
761  * seconds ( -- u )
762  */
763 static void pseconds(FICL_VM *pVM)
764 {
765 #if FICL_ROBUST > 1
766     vmCheckStack(pVM,0,1);
767 #endif
768     stackPushUNS(pVM->pStack, (FICL_UNS) time(NULL));
769     return;
770 }
771 
772 /* ms - wait at least that many milliseconds (FACILITY)
773  *
774  * ms ( u -- )
775  *
776  */
777 static void ms(FICL_VM *pVM)
778 {
779 #if FICL_ROBUST > 1
780     vmCheckStack(pVM,1,0);
781 #endif
782 #ifdef TESTMAIN
783     usleep(stackPopUNS(pVM->pStack)*1000);
784 #else
785     delay(stackPopUNS(pVM->pStack)*1000);
786 #endif
787     return;
788 }
789 
790 /*           fkey - get a character from a file
791  *
792  * fkey ( file -- char )
793  */
794 static void fkey(FICL_VM *pVM)
795 {
796     int i, fd;
797     char ch;
798 
799 #if FICL_ROBUST > 1
800     vmCheckStack(pVM, 1, 1);
801 #endif
802     fd = stackPopINT(pVM->pStack);
803     i = read(fd, &ch, 1);
804     stackPushINT(pVM->pStack, i > 0 ? ch : -1);
805     return;
806 }
807 
808 
809 /*
810 ** Retrieves free space remaining on the dictionary
811 */
812 
813 static void freeHeap(FICL_VM *pVM)
814 {
815     stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
816 }
817 
818 
819 /******************* Increase dictionary size on-demand ******************/
820 
821 static void ficlDictThreshold(FICL_VM *pVM)
822 {
823     stackPushPtr(pVM->pStack, &dictThreshold);
824 }
825 
826 static void ficlDictIncrease(FICL_VM *pVM)
827 {
828     stackPushPtr(pVM->pStack, &dictIncrease);
829 }
830 
831 /**************************************************************************
832                         f i c l C o m p i l e P l a t f o r m
833 ** Build FreeBSD platform extensions into the system dictionary
834 **************************************************************************/
835 void ficlCompilePlatform(FICL_SYSTEM *pSys)
836 {
837     ficlCompileFcn **fnpp;
838     FICL_DICT *dp = pSys->dp;
839     assert (dp);
840 
841     dictAppendWord(dp, ".#",        displayCellNoPad,    FW_DEFAULT);
842     dictAppendWord(dp, "isdir?",    isdirQuestion,  FW_DEFAULT);
843     dictAppendWord(dp, "fopen",	    pfopen,	    FW_DEFAULT);
844     dictAppendWord(dp, "fclose",    pfclose,	    FW_DEFAULT);
845     dictAppendWord(dp, "fread",	    pfread,	    FW_DEFAULT);
846     dictAppendWord(dp, "freaddir",  pfreaddir,	    FW_DEFAULT);
847     dictAppendWord(dp, "fload",	    pfload,	    FW_DEFAULT);
848     dictAppendWord(dp, "fkey",	    fkey,	    FW_DEFAULT);
849     dictAppendWord(dp, "fseek",     pfseek,	    FW_DEFAULT);
850     dictAppendWord(dp, "fwrite",    pfwrite,	    FW_DEFAULT);
851     dictAppendWord(dp, "key",	    key,	    FW_DEFAULT);
852     dictAppendWord(dp, "key?",	    keyQuestion,    FW_DEFAULT);
853     dictAppendWord(dp, "ms",        ms,             FW_DEFAULT);
854     dictAppendWord(dp, "seconds",   pseconds,       FW_DEFAULT);
855     dictAppendWord(dp, "heap?",     freeHeap,       FW_DEFAULT);
856     dictAppendWord(dp, "dictthreshold", ficlDictThreshold, FW_DEFAULT);
857     dictAppendWord(dp, "dictincrease", ficlDictIncrease, FW_DEFAULT);
858 
859     dictAppendWord(dp, "setenv",    ficlSetenv,	    FW_DEFAULT);
860     dictAppendWord(dp, "setenv?",   ficlSetenvq,    FW_DEFAULT);
861     dictAppendWord(dp, "getenv",    ficlGetenv,	    FW_DEFAULT);
862     dictAppendWord(dp, "unsetenv",  ficlUnsetenv,   FW_DEFAULT);
863     dictAppendWord(dp, "copyin",    ficlCopyin,	    FW_DEFAULT);
864     dictAppendWord(dp, "copyout",   ficlCopyout,    FW_DEFAULT);
865     dictAppendWord(dp, "findfile",  ficlFindfile,   FW_DEFAULT);
866     dictAppendWord(dp, "ccall",	    ficlCcall,	    FW_DEFAULT);
867     dictAppendWord(dp, "uuid-from-string", ficlUuidFromString, FW_DEFAULT);
868     dictAppendWord(dp, "uuid-to-string", ficlUuidToString, FW_DEFAULT);
869 #ifndef TESTMAIN
870     dictAppendWord(dp, "isvirtualized?",ficlIsvirtualizedQ, FW_DEFAULT);
871 #endif
872 
873     SET_FOREACH(fnpp, Xficl_compile_set)
874 	(*fnpp)(pSys);
875 
876 #if defined(__i386__)
877     ficlSetEnv(pSys, "arch-i386",         FICL_TRUE);
878     ficlSetEnv(pSys, "arch-powerpc",      FICL_FALSE);
879 #elif defined(__powerpc__)
880     ficlSetEnv(pSys, "arch-i386",         FICL_FALSE);
881     ficlSetEnv(pSys, "arch-powerpc",      FICL_TRUE);
882 #endif
883 
884     return;
885 }
886