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