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
68void
69ficlSetenv(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
105void
106ficlSetenvq(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
143void
144ficlGetenv(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
178void
179ficlUnsetenv(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
207void
208ficlCopyin(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
229void
230ficlCopyout(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
251void
252ficlFindfile(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 */
297static void
298ficlIsvirtualizedQ(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
316void
317ficlCcall(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
345void
346ficlUuidFromString(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
387void
388ficlUuidToString(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
421int 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
462static 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 */
478static 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 */
506static 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, __func__) < 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 */
557static 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 */
574static 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 */
596static 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 */
669static 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 */
686static 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 */
708static 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 */
726static 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 */
739static 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 */
763static 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 */
777static 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 */
794static 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
813static void freeHeap(FICL_VM *pVM)
814{
815    stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
816}
817
818
819/******************* Increase dictionary size on-demand ******************/
820
821static void ficlDictThreshold(FICL_VM *pVM)
822{
823    stackPushPtr(pVM->pStack, &dictThreshold);
824}
825
826static 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**************************************************************************/
835void 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