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 ) */
72void
73ficl_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 ) */
123void
124ficl_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
162void
163ficl_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
176void
177ficl_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
193void
194ficl_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
212void
213ficl_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
229void
230ficl_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
246void
247ficlSetenv(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
283void
284ficlSetenvq(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
321void
322ficlGetenv(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
356void
357ficlUnsetenv(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
385void
386ficlCopyin(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
407void
408ficlCopyout(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
429void
430ficlFindfile(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 */
475static void
476ficlIsvirtualizedQ(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
494void
495ficlCcall(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
523void
524ficlUuidFromString(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
565void
566ficlUuidToString(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
599int 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
640static 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 */
656static 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 */
684static 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 */
735static 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 */
752static 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 */
774static 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 */
847static 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 */
864static 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 */
886static 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 */
904static 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 */
917static 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 */
941static 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 */
955static 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 */
972static 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
991static void freeHeap(FICL_VM *pVM)
992{
993    stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
994}
995
996
997/******************* Increase dictionary size on-demand ******************/
998
999static void ficlDictThreshold(FICL_VM *pVM)
1000{
1001    stackPushPtr(pVM->pStack, &dictThreshold);
1002}
1003
1004static 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**************************************************************************/
1013void 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