xref: /freebsd/stand/ficl/loader.c (revision 42249ef2) 
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 void
291 ficlCcall(FICL_VM *pVM)
292 {
293 	int (*func)(int, ...);
294 	int result, p[10];
295 	int nparam, i;
296 
297 #if FICL_ROBUST > 1
298 	vmCheckStack(pVM, 2, 0);
299 #endif
300 
301 	func = stackPopPtr(pVM->pStack);
302 	nparam = stackPopINT(pVM->pStack);
303 
304 #if FICL_ROBUST > 1
305 	vmCheckStack(pVM, nparam, 1);
306 #endif
307 
308 	for (i = 0; i < nparam; i++)
309 		p[i] = stackPopINT(pVM->pStack);
310 
311 	result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8],
312 	    p[9]);
313 
314 	stackPushINT(pVM->pStack, result);
315 
316 	return;
317 }
318 
319 void
320 ficlUuidFromString(FICL_VM *pVM)
321 {
322 #ifndef	TESTMAIN
323 	char	*uuid;
324 	uint32_t status;
325 #endif
326 	char	*uuidp;
327 	int	uuids;
328 	uuid_t	*u;
329 
330 #if FICL_ROBUST > 1
331 	vmCheckStack(pVM, 2, 0);
332 #endif
333 
334 	uuids = stackPopINT(pVM->pStack);
335 	uuidp = (char *) stackPopPtr(pVM->pStack);
336 
337 #ifndef	TESTMAIN
338 	uuid = (char *)ficlMalloc(uuids + 1);
339 	if (!uuid)
340 		vmThrowErr(pVM, "Error: out of memory");
341 	strncpy(uuid, uuidp, uuids);
342 	uuid[uuids] = '\0';
343 
344 	u = (uuid_t *)ficlMalloc(sizeof (*u));
345 
346 	uuid_from_string(uuid, u, &status);
347 	ficlFree(uuid);
348 	if (status != uuid_s_ok) {
349 		ficlFree(u);
350 		u = NULL;
351 	}
352 #else
353 	u = NULL;
354 #endif
355 	stackPushPtr(pVM->pStack, u);
356 
357 
358 	return;
359 }
360 
361 void
362 ficlUuidToString(FICL_VM *pVM)
363 {
364 #ifndef	TESTMAIN
365 	char	*uuid;
366 	uint32_t status;
367 #endif
368 	uuid_t	*u;
369 
370 #if FICL_ROBUST > 1
371 	vmCheckStack(pVM, 1, 0);
372 #endif
373 
374 	u = (uuid_t *)stackPopPtr(pVM->pStack);
375 
376 #ifndef	TESTMAIN
377 	uuid_to_string(u, &uuid, &status);
378 	if (status != uuid_s_ok) {
379 		stackPushPtr(pVM->pStack, uuid);
380 		stackPushINT(pVM->pStack, strlen(uuid));
381 	} else
382 #endif
383 		stackPushINT(pVM->pStack, -1);
384 
385 	return;
386 }
387 
388 /**************************************************************************
389                         f i c l E x e c F D
390 ** reads in text from file fd and passes it to ficlExec()
391  * returns VM_OUTOFTEXT on success or the ficlExec() error code on
392  * failure.
393  */
394 #define nLINEBUF 256
395 int ficlExecFD(FICL_VM *pVM, int fd)
396 {
397     char    cp[nLINEBUF];
398     int     nLine = 0, rval = VM_OUTOFTEXT;
399     char    ch;
400     CELL    id;
401 
402     id = pVM->sourceID;
403     pVM->sourceID.i = fd;
404 
405     /* feed each line to ficlExec */
406     while (1) {
407 	int status, i;
408 
409 	i = 0;
410 	while ((status = read(fd, &ch, 1)) > 0 && ch != '\n')
411 	    cp[i++] = ch;
412         nLine++;
413 	if (!i) {
414 	    if (status < 1)
415 		break;
416 	    continue;
417 	}
418         rval = ficlExecC(pVM, cp, i);
419 	if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT)
420         {
421             pVM->sourceID = id;
422             return rval;
423         }
424     }
425     /*
426     ** Pass an empty line with SOURCE-ID == -1 to flush
427     ** any pending REFILLs (as required by FILE wordset)
428     */
429     pVM->sourceID.i = -1;
430     ficlExec(pVM, "");
431 
432     pVM->sourceID = id;
433     return rval;
434 }
435 
436 static void displayCellNoPad(FICL_VM *pVM)
437 {
438     CELL c;
439 #if FICL_ROBUST > 1
440     vmCheckStack(pVM, 1, 0);
441 #endif
442     c = stackPop(pVM->pStack);
443     ltoa((c).i, pVM->pad, pVM->base);
444     vmTextOut(pVM, pVM->pad, 0);
445     return;
446 }
447 
448 /*      isdir? - Return whether an fd corresponds to a directory.
449  *
450  * isdir? ( fd -- bool )
451  */
452 static void isdirQuestion(FICL_VM *pVM)
453 {
454     struct stat sb;
455     FICL_INT flag;
456     int fd;
457 
458 #if FICL_ROBUST > 1
459     vmCheckStack(pVM, 1, 1);
460 #endif
461 
462     fd = stackPopINT(pVM->pStack);
463     flag = FICL_FALSE;
464     do {
465         if (fd < 0)
466             break;
467         if (fstat(fd, &sb) < 0)
468             break;
469         if (!S_ISDIR(sb.st_mode))
470             break;
471         flag = FICL_TRUE;
472     } while (0);
473     stackPushINT(pVM->pStack, flag);
474 }
475 
476 /*          fopen - open a file and return new fd on stack.
477  *
478  * fopen ( ptr count mode -- fd )
479  */
480 static void pfopen(FICL_VM *pVM)
481 {
482     int     mode, fd, count;
483     char    *ptr, *name;
484 
485 #if FICL_ROBUST > 1
486     vmCheckStack(pVM, 3, 1);
487 #endif
488 
489     mode = stackPopINT(pVM->pStack);    /* get mode */
490     count = stackPopINT(pVM->pStack);   /* get count */
491     ptr = stackPopPtr(pVM->pStack);     /* get ptr */
492 
493     if ((count < 0) || (ptr == NULL)) {
494         stackPushINT(pVM->pStack, -1);
495         return;
496     }
497 
498     /* ensure that the string is null terminated */
499     name = (char *)malloc(count+1);
500     bcopy(ptr,name,count);
501     name[count] = 0;
502 
503     /* open the file */
504     fd = open(name, mode);
505 #ifdef LOADER_VERIEXEC
506     if (fd >= 0) {
507 	if (verify_file(fd, name, 0, VE_GUESS) < 0) {
508 	    /* not verified writing ok but reading is not */
509 	    if ((mode & O_ACCMODE) != O_WRONLY) {
510 		close(fd);
511 		fd = -1;
512 	    }
513 	} else {
514 	    /* verified reading ok but writing is not */
515 	    if ((mode & O_ACCMODE) != O_RDONLY) {
516 		close(fd);
517 		fd = -1;
518 	    }
519 	}
520     }
521 #endif
522     free(name);
523     stackPushINT(pVM->pStack, fd);
524     return;
525 }
526 
527 /*          fclose - close a file who's fd is on stack.
528  *
529  * fclose ( fd -- )
530  */
531 static void pfclose(FICL_VM *pVM)
532 {
533     int fd;
534 
535 #if FICL_ROBUST > 1
536     vmCheckStack(pVM, 1, 0);
537 #endif
538     fd = stackPopINT(pVM->pStack); /* get fd */
539     if (fd != -1)
540 	close(fd);
541     return;
542 }
543 
544 /*          fread - read file contents
545  *
546  * fread  ( fd buf nbytes  -- nread )
547  */
548 static void pfread(FICL_VM *pVM)
549 {
550     int     fd, len;
551     char *buf;
552 
553 #if FICL_ROBUST > 1
554     vmCheckStack(pVM, 3, 1);
555 #endif
556     len = stackPopINT(pVM->pStack); /* get number of bytes to read */
557     buf = stackPopPtr(pVM->pStack); /* get buffer */
558     fd = stackPopINT(pVM->pStack); /* get fd */
559     if (len > 0 && buf && fd != -1)
560 	stackPushINT(pVM->pStack, read(fd, buf, len));
561     else
562 	stackPushINT(pVM->pStack, -1);
563     return;
564 }
565 
566 /*      freaddir - read directory contents
567  *
568  * freaddir ( fd -- ptr len TRUE | FALSE )
569  */
570 static void pfreaddir(FICL_VM *pVM)
571 {
572 #ifdef TESTMAIN
573     static struct dirent dirent;
574     struct stat sb;
575     char *buf;
576     off_t off, ptr;
577     u_int blksz;
578     int bufsz;
579 #endif
580     struct dirent *d;
581     int fd;
582 
583 #if FICL_ROBUST > 1
584     vmCheckStack(pVM, 1, 3);
585 #endif
586 
587     fd = stackPopINT(pVM->pStack);
588 #if TESTMAIN
589     /*
590      * The readdirfd() function is specific to the loader environment.
591      * We do the best we can to make freaddir work, but it's not at
592      * all guaranteed.
593      */
594     d = NULL;
595     buf = NULL;
596     do {
597 	if (fd == -1)
598 	    break;
599 	if (fstat(fd, &sb) == -1)
600 	    break;
601 	blksz = (sb.st_blksize) ? sb.st_blksize : getpagesize();
602 	if ((blksz & (blksz - 1)) != 0)
603 	    break;
604 	buf = malloc(blksz);
605 	if (buf == NULL)
606 	    break;
607 	off = lseek(fd, 0LL, SEEK_CUR);
608 	if (off == -1)
609 	    break;
610 	ptr = off;
611 	if (lseek(fd, 0, SEEK_SET) == -1)
612 	    break;
613 	bufsz = getdents(fd, buf, blksz);
614 	while (bufsz > 0 && bufsz <= ptr) {
615 	    ptr -= bufsz;
616 	    bufsz = getdents(fd, buf, blksz);
617 	}
618 	if (bufsz <= 0)
619 	    break;
620 	d = (void *)(buf + ptr);
621 	dirent = *d;
622 	off += d->d_reclen;
623 	d = (lseek(fd, off, SEEK_SET) != off) ? NULL : &dirent;
624     } while (0);
625     if (buf != NULL)
626 	free(buf);
627 #else
628     d = readdirfd(fd);
629 #endif
630     if (d != NULL) {
631         stackPushPtr(pVM->pStack, d->d_name);
632         stackPushINT(pVM->pStack, strlen(d->d_name));
633         stackPushINT(pVM->pStack, FICL_TRUE);
634     } else {
635         stackPushINT(pVM->pStack, FICL_FALSE);
636     }
637 }
638 
639 /*          fload - interpret file contents
640  *
641  * fload  ( fd -- )
642  */
643 static void pfload(FICL_VM *pVM)
644 {
645     int     fd;
646 
647 #if FICL_ROBUST > 1
648     vmCheckStack(pVM, 1, 0);
649 #endif
650     fd = stackPopINT(pVM->pStack); /* get fd */
651     if (fd != -1)
652 	ficlExecFD(pVM, fd);
653     return;
654 }
655 
656 /*          fwrite - write file contents
657  *
658  * fwrite  ( fd buf nbytes  -- nwritten )
659  */
660 static void pfwrite(FICL_VM *pVM)
661 {
662     int     fd, len;
663     char *buf;
664 
665 #if FICL_ROBUST > 1
666     vmCheckStack(pVM, 3, 1);
667 #endif
668     len = stackPopINT(pVM->pStack); /* get number of bytes to read */
669     buf = stackPopPtr(pVM->pStack); /* get buffer */
670     fd = stackPopINT(pVM->pStack); /* get fd */
671     if (len > 0 && buf && fd != -1)
672 	stackPushINT(pVM->pStack, write(fd, buf, len));
673     else
674 	stackPushINT(pVM->pStack, -1);
675     return;
676 }
677 
678 /*          fseek - seek to a new position in a file
679  *
680  * fseek  ( fd ofs whence  -- pos )
681  */
682 static void pfseek(FICL_VM *pVM)
683 {
684     int     fd, pos, whence;
685 
686 #if FICL_ROBUST > 1
687     vmCheckStack(pVM, 3, 1);
688 #endif
689     whence = stackPopINT(pVM->pStack);
690     pos = stackPopINT(pVM->pStack);
691     fd = stackPopINT(pVM->pStack);
692     stackPushINT(pVM->pStack, lseek(fd, pos, whence));
693     return;
694 }
695 
696 /*           key - get a character from stdin
697  *
698  * key ( -- char )
699  */
700 static void key(FICL_VM *pVM)
701 {
702 #if FICL_ROBUST > 1
703     vmCheckStack(pVM, 0, 1);
704 #endif
705     stackPushINT(pVM->pStack, getchar());
706     return;
707 }
708 
709 /*           key? - check for a character from stdin (FACILITY)
710  *
711  * key? ( -- flag )
712  */
713 static void keyQuestion(FICL_VM *pVM)
714 {
715 #if FICL_ROBUST > 1
716     vmCheckStack(pVM, 0, 1);
717 #endif
718 #ifdef TESTMAIN
719     /* XXX Since we don't fiddle with termios, let it always succeed... */
720     stackPushINT(pVM->pStack, FICL_TRUE);
721 #else
722     /* But here do the right thing. */
723     stackPushINT(pVM->pStack, ischar()? FICL_TRUE : FICL_FALSE);
724 #endif
725     return;
726 }
727 
728 /* seconds - gives number of seconds since beginning of time
729  *
730  * beginning of time is defined as:
731  *
732  *	BTX	- number of seconds since midnight
733  *	FreeBSD	- number of seconds since Jan 1 1970
734  *
735  * seconds ( -- u )
736  */
737 static void pseconds(FICL_VM *pVM)
738 {
739 #if FICL_ROBUST > 1
740     vmCheckStack(pVM,0,1);
741 #endif
742     stackPushUNS(pVM->pStack, (FICL_UNS) time(NULL));
743     return;
744 }
745 
746 /* ms - wait at least that many milliseconds (FACILITY)
747  *
748  * ms ( u -- )
749  *
750  */
751 static void ms(FICL_VM *pVM)
752 {
753 #if FICL_ROBUST > 1
754     vmCheckStack(pVM,1,0);
755 #endif
756 #ifdef TESTMAIN
757     usleep(stackPopUNS(pVM->pStack)*1000);
758 #else
759     delay(stackPopUNS(pVM->pStack)*1000);
760 #endif
761     return;
762 }
763 
764 /*           fkey - get a character from a file
765  *
766  * fkey ( file -- char )
767  */
768 static void fkey(FICL_VM *pVM)
769 {
770     int i, fd;
771     char ch;
772 
773 #if FICL_ROBUST > 1
774     vmCheckStack(pVM, 1, 1);
775 #endif
776     fd = stackPopINT(pVM->pStack);
777     i = read(fd, &ch, 1);
778     stackPushINT(pVM->pStack, i > 0 ? ch : -1);
779     return;
780 }
781 
782 
783 /*
784 ** Retrieves free space remaining on the dictionary
785 */
786 
787 static void freeHeap(FICL_VM *pVM)
788 {
789     stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
790 }
791 
792 
793 /******************* Increase dictionary size on-demand ******************/
794 
795 static void ficlDictThreshold(FICL_VM *pVM)
796 {
797     stackPushPtr(pVM->pStack, &dictThreshold);
798 }
799 
800 static void ficlDictIncrease(FICL_VM *pVM)
801 {
802     stackPushPtr(pVM->pStack, &dictIncrease);
803 }
804 
805 /**************************************************************************
806                         f i c l C o m p i l e P l a t f o r m
807 ** Build FreeBSD platform extensions into the system dictionary
808 **************************************************************************/
809 void ficlCompilePlatform(FICL_SYSTEM *pSys)
810 {
811     ficlCompileFcn **fnpp;
812     FICL_DICT *dp = pSys->dp;
813     assert (dp);
814 
815     dictAppendWord(dp, ".#",        displayCellNoPad,    FW_DEFAULT);
816     dictAppendWord(dp, "isdir?",    isdirQuestion,  FW_DEFAULT);
817     dictAppendWord(dp, "fopen",	    pfopen,	    FW_DEFAULT);
818     dictAppendWord(dp, "fclose",    pfclose,	    FW_DEFAULT);
819     dictAppendWord(dp, "fread",	    pfread,	    FW_DEFAULT);
820     dictAppendWord(dp, "freaddir",  pfreaddir,	    FW_DEFAULT);
821     dictAppendWord(dp, "fload",	    pfload,	    FW_DEFAULT);
822     dictAppendWord(dp, "fkey",	    fkey,	    FW_DEFAULT);
823     dictAppendWord(dp, "fseek",     pfseek,	    FW_DEFAULT);
824     dictAppendWord(dp, "fwrite",    pfwrite,	    FW_DEFAULT);
825     dictAppendWord(dp, "key",	    key,	    FW_DEFAULT);
826     dictAppendWord(dp, "key?",	    keyQuestion,    FW_DEFAULT);
827     dictAppendWord(dp, "ms",        ms,             FW_DEFAULT);
828     dictAppendWord(dp, "seconds",   pseconds,       FW_DEFAULT);
829     dictAppendWord(dp, "heap?",     freeHeap,       FW_DEFAULT);
830     dictAppendWord(dp, "dictthreshold", ficlDictThreshold, FW_DEFAULT);
831     dictAppendWord(dp, "dictincrease", ficlDictIncrease, FW_DEFAULT);
832 
833     dictAppendWord(dp, "setenv",    ficlSetenv,	    FW_DEFAULT);
834     dictAppendWord(dp, "setenv?",   ficlSetenvq,    FW_DEFAULT);
835     dictAppendWord(dp, "getenv",    ficlGetenv,	    FW_DEFAULT);
836     dictAppendWord(dp, "unsetenv",  ficlUnsetenv,   FW_DEFAULT);
837     dictAppendWord(dp, "copyin",    ficlCopyin,	    FW_DEFAULT);
838     dictAppendWord(dp, "copyout",   ficlCopyout,    FW_DEFAULT);
839     dictAppendWord(dp, "findfile",  ficlFindfile,   FW_DEFAULT);
840     dictAppendWord(dp, "ccall",	    ficlCcall,	    FW_DEFAULT);
841     dictAppendWord(dp, "uuid-from-string", ficlUuidFromString, FW_DEFAULT);
842     dictAppendWord(dp, "uuid-to-string", ficlUuidToString, FW_DEFAULT);
843 
844     SET_FOREACH(fnpp, Xficl_compile_set)
845 	(*fnpp)(pSys);
846 
847 #if defined(__i386__)
848     ficlSetEnv(pSys, "arch-i386",         FICL_TRUE);
849     ficlSetEnv(pSys, "arch-powerpc",      FICL_FALSE);
850 #elif defined(__powerpc__)
851     ficlSetEnv(pSys, "arch-i386",         FICL_FALSE);
852     ficlSetEnv(pSys, "arch-powerpc",      FICL_TRUE);
853 #endif
854 
855     return;
856 }
857