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