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