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
66 void
ficlSetenv(FICL_VM * pVM)67 ficlSetenv(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
103 void
ficlSetenvq(FICL_VM * pVM)104 ficlSetenvq(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
141 void
ficlGetenv(FICL_VM * pVM)142 ficlGetenv(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
176 void
ficlUnsetenv(FICL_VM * pVM)177 ficlUnsetenv(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
205 void
ficlCopyin(FICL_VM * pVM)206 ficlCopyin(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
227 void
ficlCopyout(FICL_VM * pVM)228 ficlCopyout(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
249 void
ficlFindfile(FICL_VM * pVM)250 ficlFindfile(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 */
295 static void
ficlIsvirtualizedQ(FICL_VM * pVM)296 ficlIsvirtualizedQ(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
314 void
ficlCcall(FICL_VM * pVM)315 ficlCcall(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
343 void
ficlUuidFromString(FICL_VM * pVM)344 ficlUuidFromString(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
385 void
ficlUuidToString(FICL_VM * pVM)386 ficlUuidToString(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
ficlExecFD(FICL_VM * pVM,int fd)419 int 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
displayCellNoPad(FICL_VM * pVM)460 static 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 */
isdirQuestion(FICL_VM * pVM)476 static 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 */
pfopen(FICL_VM * pVM)504 static 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 */
pfclose(FICL_VM * pVM)555 static 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 */
pfread(FICL_VM * pVM)572 static 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 */
pfreaddir(FICL_VM * pVM)594 static 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 */
pfload(FICL_VM * pVM)667 static 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 */
pfwrite(FICL_VM * pVM)684 static 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 */
pfseek(FICL_VM * pVM)706 static 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 */
key(FICL_VM * pVM)724 static 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 */
keyQuestion(FICL_VM * pVM)737 static 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 */
pseconds(FICL_VM * pVM)761 static 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 */
ms(FICL_VM * pVM)775 static 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 */
fkey(FICL_VM * pVM)792 static 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
freeHeap(FICL_VM * pVM)811 static void freeHeap(FICL_VM *pVM)
812 {
813 stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
814 }
815
816
817 /******************* Increase dictionary size on-demand ******************/
818
ficlDictThreshold(FICL_VM * pVM)819 static void ficlDictThreshold(FICL_VM *pVM)
820 {
821 stackPushPtr(pVM->pStack, &dictThreshold);
822 }
823
ficlDictIncrease(FICL_VM * pVM)824 static 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 **************************************************************************/
ficlCompilePlatform(FICL_SYSTEM * pSys)833 void 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