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
ficlSetenv(FICL_VM * pVM)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
ficlSetenvq(FICL_VM * pVM)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
ficlGetenv(FICL_VM * pVM)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
ficlUnsetenv(FICL_VM * pVM)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
ficlCopyin(FICL_VM * pVM)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
ficlCopyout(FICL_VM * pVM)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
ficlFindfile(FICL_VM * pVM)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
ficlCcall(FICL_VM * pVM)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
ficlUuidFromString(FICL_VM * pVM)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
ficlUuidToString(FICL_VM * pVM)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
ficlExecFD(FICL_VM * pVM,int fd)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
displayCellNoPad(FICL_VM * pVM)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 */
isdirQuestion(FICL_VM * pVM)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 */
pfopen(FICL_VM * pVM)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 #ifdef LOADER_VERIEXEC
506 if (fd >= 0) {
507 if (verify_file(fd, name, 0, VE_GUESS) < 0) {
508 /* not verified writing ok but reading is not */
509 if ((mode & O_ACCMODE) != O_WRONLY) {
510 close(fd);
511 fd = -1;
512 }
513 } else {
514 /* verified reading ok but writing is not */
515 if ((mode & O_ACCMODE) != O_RDONLY) {
516 close(fd);
517 fd = -1;
518 }
519 }
520 }
521 #endif
522 free(name);
523 stackPushINT(pVM->pStack, fd);
524 return;
525 }
526
527 /* fclose - close a file who's fd is on stack.
528 *
529 * fclose ( fd -- )
530 */
pfclose(FICL_VM * pVM)531 static void pfclose(FICL_VM *pVM)
532 {
533 int fd;
534
535 #if FICL_ROBUST > 1
536 vmCheckStack(pVM, 1, 0);
537 #endif
538 fd = stackPopINT(pVM->pStack); /* get fd */
539 if (fd != -1)
540 close(fd);
541 return;
542 }
543
544 /* fread - read file contents
545 *
546 * fread ( fd buf nbytes -- nread )
547 */
pfread(FICL_VM * pVM)548 static void pfread(FICL_VM *pVM)
549 {
550 int fd, len;
551 char *buf;
552
553 #if FICL_ROBUST > 1
554 vmCheckStack(pVM, 3, 1);
555 #endif
556 len = stackPopINT(pVM->pStack); /* get number of bytes to read */
557 buf = stackPopPtr(pVM->pStack); /* get buffer */
558 fd = stackPopINT(pVM->pStack); /* get fd */
559 if (len > 0 && buf && fd != -1)
560 stackPushINT(pVM->pStack, read(fd, buf, len));
561 else
562 stackPushINT(pVM->pStack, -1);
563 return;
564 }
565
566 /* freaddir - read directory contents
567 *
568 * freaddir ( fd -- ptr len TRUE | FALSE )
569 */
pfreaddir(FICL_VM * pVM)570 static void pfreaddir(FICL_VM *pVM)
571 {
572 #ifdef TESTMAIN
573 static struct dirent dirent;
574 struct stat sb;
575 char *buf;
576 off_t off, ptr;
577 u_int blksz;
578 int bufsz;
579 #endif
580 struct dirent *d;
581 int fd;
582
583 #if FICL_ROBUST > 1
584 vmCheckStack(pVM, 1, 3);
585 #endif
586
587 fd = stackPopINT(pVM->pStack);
588 #if TESTMAIN
589 /*
590 * The readdirfd() function is specific to the loader environment.
591 * We do the best we can to make freaddir work, but it's not at
592 * all guaranteed.
593 */
594 d = NULL;
595 buf = NULL;
596 do {
597 if (fd == -1)
598 break;
599 if (fstat(fd, &sb) == -1)
600 break;
601 blksz = (sb.st_blksize) ? sb.st_blksize : getpagesize();
602 if ((blksz & (blksz - 1)) != 0)
603 break;
604 buf = malloc(blksz);
605 if (buf == NULL)
606 break;
607 off = lseek(fd, 0LL, SEEK_CUR);
608 if (off == -1)
609 break;
610 ptr = off;
611 if (lseek(fd, 0, SEEK_SET) == -1)
612 break;
613 bufsz = getdents(fd, buf, blksz);
614 while (bufsz > 0 && bufsz <= ptr) {
615 ptr -= bufsz;
616 bufsz = getdents(fd, buf, blksz);
617 }
618 if (bufsz <= 0)
619 break;
620 d = (void *)(buf + ptr);
621 dirent = *d;
622 off += d->d_reclen;
623 d = (lseek(fd, off, SEEK_SET) != off) ? NULL : &dirent;
624 } while (0);
625 if (buf != NULL)
626 free(buf);
627 #else
628 d = readdirfd(fd);
629 #endif
630 if (d != NULL) {
631 stackPushPtr(pVM->pStack, d->d_name);
632 stackPushINT(pVM->pStack, strlen(d->d_name));
633 stackPushINT(pVM->pStack, FICL_TRUE);
634 } else {
635 stackPushINT(pVM->pStack, FICL_FALSE);
636 }
637 }
638
639 /* fload - interpret file contents
640 *
641 * fload ( fd -- )
642 */
pfload(FICL_VM * pVM)643 static void pfload(FICL_VM *pVM)
644 {
645 int fd;
646
647 #if FICL_ROBUST > 1
648 vmCheckStack(pVM, 1, 0);
649 #endif
650 fd = stackPopINT(pVM->pStack); /* get fd */
651 if (fd != -1)
652 ficlExecFD(pVM, fd);
653 return;
654 }
655
656 /* fwrite - write file contents
657 *
658 * fwrite ( fd buf nbytes -- nwritten )
659 */
pfwrite(FICL_VM * pVM)660 static void pfwrite(FICL_VM *pVM)
661 {
662 int fd, len;
663 char *buf;
664
665 #if FICL_ROBUST > 1
666 vmCheckStack(pVM, 3, 1);
667 #endif
668 len = stackPopINT(pVM->pStack); /* get number of bytes to read */
669 buf = stackPopPtr(pVM->pStack); /* get buffer */
670 fd = stackPopINT(pVM->pStack); /* get fd */
671 if (len > 0 && buf && fd != -1)
672 stackPushINT(pVM->pStack, write(fd, buf, len));
673 else
674 stackPushINT(pVM->pStack, -1);
675 return;
676 }
677
678 /* fseek - seek to a new position in a file
679 *
680 * fseek ( fd ofs whence -- pos )
681 */
pfseek(FICL_VM * pVM)682 static void pfseek(FICL_VM *pVM)
683 {
684 int fd, pos, whence;
685
686 #if FICL_ROBUST > 1
687 vmCheckStack(pVM, 3, 1);
688 #endif
689 whence = stackPopINT(pVM->pStack);
690 pos = stackPopINT(pVM->pStack);
691 fd = stackPopINT(pVM->pStack);
692 stackPushINT(pVM->pStack, lseek(fd, pos, whence));
693 return;
694 }
695
696 /* key - get a character from stdin
697 *
698 * key ( -- char )
699 */
key(FICL_VM * pVM)700 static void key(FICL_VM *pVM)
701 {
702 #if FICL_ROBUST > 1
703 vmCheckStack(pVM, 0, 1);
704 #endif
705 stackPushINT(pVM->pStack, getchar());
706 return;
707 }
708
709 /* key? - check for a character from stdin (FACILITY)
710 *
711 * key? ( -- flag )
712 */
keyQuestion(FICL_VM * pVM)713 static void keyQuestion(FICL_VM *pVM)
714 {
715 #if FICL_ROBUST > 1
716 vmCheckStack(pVM, 0, 1);
717 #endif
718 #ifdef TESTMAIN
719 /* XXX Since we don't fiddle with termios, let it always succeed... */
720 stackPushINT(pVM->pStack, FICL_TRUE);
721 #else
722 /* But here do the right thing. */
723 stackPushINT(pVM->pStack, ischar()? FICL_TRUE : FICL_FALSE);
724 #endif
725 return;
726 }
727
728 /* seconds - gives number of seconds since beginning of time
729 *
730 * beginning of time is defined as:
731 *
732 * BTX - number of seconds since midnight
733 * FreeBSD - number of seconds since Jan 1 1970
734 *
735 * seconds ( -- u )
736 */
pseconds(FICL_VM * pVM)737 static void pseconds(FICL_VM *pVM)
738 {
739 #if FICL_ROBUST > 1
740 vmCheckStack(pVM,0,1);
741 #endif
742 stackPushUNS(pVM->pStack, (FICL_UNS) time(NULL));
743 return;
744 }
745
746 /* ms - wait at least that many milliseconds (FACILITY)
747 *
748 * ms ( u -- )
749 *
750 */
ms(FICL_VM * pVM)751 static void ms(FICL_VM *pVM)
752 {
753 #if FICL_ROBUST > 1
754 vmCheckStack(pVM,1,0);
755 #endif
756 #ifdef TESTMAIN
757 usleep(stackPopUNS(pVM->pStack)*1000);
758 #else
759 delay(stackPopUNS(pVM->pStack)*1000);
760 #endif
761 return;
762 }
763
764 /* fkey - get a character from a file
765 *
766 * fkey ( file -- char )
767 */
fkey(FICL_VM * pVM)768 static void fkey(FICL_VM *pVM)
769 {
770 int i, fd;
771 char ch;
772
773 #if FICL_ROBUST > 1
774 vmCheckStack(pVM, 1, 1);
775 #endif
776 fd = stackPopINT(pVM->pStack);
777 i = read(fd, &ch, 1);
778 stackPushINT(pVM->pStack, i > 0 ? ch : -1);
779 return;
780 }
781
782
783 /*
784 ** Retrieves free space remaining on the dictionary
785 */
786
freeHeap(FICL_VM * pVM)787 static void freeHeap(FICL_VM *pVM)
788 {
789 stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
790 }
791
792
793 /******************* Increase dictionary size on-demand ******************/
794
ficlDictThreshold(FICL_VM * pVM)795 static void ficlDictThreshold(FICL_VM *pVM)
796 {
797 stackPushPtr(pVM->pStack, &dictThreshold);
798 }
799
ficlDictIncrease(FICL_VM * pVM)800 static void ficlDictIncrease(FICL_VM *pVM)
801 {
802 stackPushPtr(pVM->pStack, &dictIncrease);
803 }
804
805 /**************************************************************************
806 f i c l C o m p i l e P l a t f o r m
807 ** Build FreeBSD platform extensions into the system dictionary
808 **************************************************************************/
ficlCompilePlatform(FICL_SYSTEM * pSys)809 void ficlCompilePlatform(FICL_SYSTEM *pSys)
810 {
811 ficlCompileFcn **fnpp;
812 FICL_DICT *dp = pSys->dp;
813 assert (dp);
814
815 dictAppendWord(dp, ".#", displayCellNoPad, FW_DEFAULT);
816 dictAppendWord(dp, "isdir?", isdirQuestion, FW_DEFAULT);
817 dictAppendWord(dp, "fopen", pfopen, FW_DEFAULT);
818 dictAppendWord(dp, "fclose", pfclose, FW_DEFAULT);
819 dictAppendWord(dp, "fread", pfread, FW_DEFAULT);
820 dictAppendWord(dp, "freaddir", pfreaddir, FW_DEFAULT);
821 dictAppendWord(dp, "fload", pfload, FW_DEFAULT);
822 dictAppendWord(dp, "fkey", fkey, FW_DEFAULT);
823 dictAppendWord(dp, "fseek", pfseek, FW_DEFAULT);
824 dictAppendWord(dp, "fwrite", pfwrite, FW_DEFAULT);
825 dictAppendWord(dp, "key", key, FW_DEFAULT);
826 dictAppendWord(dp, "key?", keyQuestion, FW_DEFAULT);
827 dictAppendWord(dp, "ms", ms, FW_DEFAULT);
828 dictAppendWord(dp, "seconds", pseconds, FW_DEFAULT);
829 dictAppendWord(dp, "heap?", freeHeap, FW_DEFAULT);
830 dictAppendWord(dp, "dictthreshold", ficlDictThreshold, FW_DEFAULT);
831 dictAppendWord(dp, "dictincrease", ficlDictIncrease, FW_DEFAULT);
832
833 dictAppendWord(dp, "setenv", ficlSetenv, FW_DEFAULT);
834 dictAppendWord(dp, "setenv?", ficlSetenvq, FW_DEFAULT);
835 dictAppendWord(dp, "getenv", ficlGetenv, FW_DEFAULT);
836 dictAppendWord(dp, "unsetenv", ficlUnsetenv, FW_DEFAULT);
837 dictAppendWord(dp, "copyin", ficlCopyin, FW_DEFAULT);
838 dictAppendWord(dp, "copyout", ficlCopyout, FW_DEFAULT);
839 dictAppendWord(dp, "findfile", ficlFindfile, FW_DEFAULT);
840 dictAppendWord(dp, "ccall", ficlCcall, FW_DEFAULT);
841 dictAppendWord(dp, "uuid-from-string", ficlUuidFromString, FW_DEFAULT);
842 dictAppendWord(dp, "uuid-to-string", ficlUuidToString, FW_DEFAULT);
843
844 SET_FOREACH(fnpp, Xficl_compile_set)
845 (*fnpp)(pSys);
846
847 #if defined(__i386__)
848 ficlSetEnv(pSys, "arch-i386", FICL_TRUE);
849 ficlSetEnv(pSys, "arch-powerpc", FICL_FALSE);
850 #elif defined(__powerpc__)
851 ficlSetEnv(pSys, "arch-i386", FICL_FALSE);
852 ficlSetEnv(pSys, "arch-powerpc", FICL_TRUE);
853 #endif
854
855 return;
856 }
857