2 * Copyright (c) 2000 Daniel Capo Sobral
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
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.
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
29 /*******************************************************************
31 ** Additional FICL words designed for FreeBSD's loader
33 *******************************************************************/
36 #include <sys/types.h>
46 #include "bootstrap.h"
50 /* FreeBSD's loader interaction words and extras
52 * setenv ( value n name n' -- )
53 * setenv? ( value n name n' flag -- )
54 * getenv ( addr n -- addr' n' | -1 )
55 * unsetenv ( addr n -- )
56 * copyin ( addr addr' len -- )
57 * copyout ( addr addr' len -- )
58 * findfile ( name len type len' -- addr )
59 * pnpdevices ( -- addr )
60 * pnphandlers ( -- addr )
61 * ccall ( [[...[p10] p9] ... p1] n addr -- result )
66 ficlSetenv(FICL_VM *pVM)
75 vmCheckStack(pVM, 4, 0);
77 names = stackPopINT(pVM->pStack);
78 namep = (char*) stackPopPtr(pVM->pStack);
79 values = stackPopINT(pVM->pStack);
80 valuep = (char*) stackPopPtr(pVM->pStack);
83 name = (char*) ficlMalloc(names+1);
85 vmThrowErr(pVM, "Error: out of memory");
86 strncpy(name, namep, names);
88 value = (char*) ficlMalloc(values+1);
90 vmThrowErr(pVM, "Error: out of memory");
91 strncpy(value, valuep, values);
94 setenv(name, value, 1);
103 ficlSetenvq(FICL_VM *pVM)
108 char *namep, *valuep;
109 int names, values, overwrite;
112 vmCheckStack(pVM, 5, 0);
114 overwrite = stackPopINT(pVM->pStack);
115 names = stackPopINT(pVM->pStack);
116 namep = (char*) stackPopPtr(pVM->pStack);
117 values = stackPopINT(pVM->pStack);
118 valuep = (char*) stackPopPtr(pVM->pStack);
121 name = (char*) ficlMalloc(names+1);
123 vmThrowErr(pVM, "Error: out of memory");
124 strncpy(name, namep, names);
126 value = (char*) ficlMalloc(values+1);
128 vmThrowErr(pVM, "Error: out of memory");
129 strncpy(value, valuep, values);
130 value[values] = '\0';
132 setenv(name, value, overwrite);
141 ficlGetenv(FICL_VM *pVM)
150 vmCheckStack(pVM, 2, 2);
152 names = stackPopINT(pVM->pStack);
153 namep = (char*) stackPopPtr(pVM->pStack);
156 name = (char*) ficlMalloc(names+1);
158 vmThrowErr(pVM, "Error: out of memory");
159 strncpy(name, namep, names);
162 value = getenv(name);
166 stackPushPtr(pVM->pStack, value);
167 stackPushINT(pVM->pStack, strlen(value));
170 stackPushINT(pVM->pStack, -1);
176 ficlUnsetenv(FICL_VM *pVM)
185 vmCheckStack(pVM, 2, 0);
187 names = stackPopINT(pVM->pStack);
188 namep = (char*) stackPopPtr(pVM->pStack);
191 name = (char*) ficlMalloc(names+1);
193 vmThrowErr(pVM, "Error: out of memory");
194 strncpy(name, namep, names);
205 ficlCopyin(FICL_VM *pVM)
212 vmCheckStack(pVM, 3, 0);
215 len = stackPopINT(pVM->pStack);
216 dest = stackPopINT(pVM->pStack);
217 src = stackPopPtr(pVM->pStack);
220 archsw.arch_copyin(src, dest, len);
227 ficlCopyout(FICL_VM *pVM)
234 vmCheckStack(pVM, 3, 0);
237 len = stackPopINT(pVM->pStack);
238 dest = stackPopPtr(pVM->pStack);
239 src = stackPopINT(pVM->pStack);
242 archsw.arch_copyout(src, dest, len);
249 ficlFindfile(FICL_VM *pVM)
255 struct preloaded_file* fp;
259 vmCheckStack(pVM, 4, 1);
262 types = stackPopINT(pVM->pStack);
263 typep = (char*) stackPopPtr(pVM->pStack);
264 names = stackPopINT(pVM->pStack);
265 namep = (char*) stackPopPtr(pVM->pStack);
267 name = (char*) ficlMalloc(names+1);
269 vmThrowErr(pVM, "Error: out of memory");
270 strncpy(name, namep, names);
272 type = (char*) ficlMalloc(types+1);
274 vmThrowErr(pVM, "Error: out of memory");
275 strncpy(type, typep, types);
278 fp = file_findfile(name, type);
282 stackPushPtr(pVM->pStack, fp);
291 ficlPnpdevices(FICL_VM *pVM)
293 static int pnp_devices_initted = 0;
295 vmCheckStack(pVM, 0, 1);
298 if(!pnp_devices_initted) {
299 STAILQ_INIT(&pnp_devices);
300 pnp_devices_initted = 1;
303 stackPushPtr(pVM->pStack, &pnp_devices);
309 ficlPnphandlers(FICL_VM *pVM)
312 vmCheckStack(pVM, 0, 1);
315 stackPushPtr(pVM->pStack, pnphandlers);
322 #endif /* ndef TESTMAIN */
325 ficlCcall(FICL_VM *pVM)
327 int (*func)(int, ...);
332 vmCheckStack(pVM, 2, 0);
335 func = stackPopPtr(pVM->pStack);
336 nparam = stackPopINT(pVM->pStack);
339 vmCheckStack(pVM, nparam, 1);
342 for (i = 0; i < nparam; i++)
343 p[i] = stackPopINT(pVM->pStack);
345 result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8],
348 stackPushINT(pVM->pStack, result);
353 /**************************************************************************
355 ** reads in text from file fd and passes it to ficlExec()
356 * returns VM_OUTOFTEXT on success or the ficlExec() error code on
360 int ficlExecFD(FICL_VM *pVM, int fd)
363 int nLine = 0, rval = VM_OUTOFTEXT;
368 pVM->sourceID.i = fd;
370 /* feed each line to ficlExec */
375 while ((status = read(fd, &ch, 1)) > 0 && ch != '\n')
383 rval = ficlExecC(pVM, cp, i);
384 if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT)
391 ** Pass an empty line with SOURCE-ID == -1 to flush
392 ** any pending REFILLs (as required by FILE wordset)
394 pVM->sourceID.i = -1;
401 static void displayCellNoPad(FICL_VM *pVM)
405 vmCheckStack(pVM, 1, 0);
407 c = stackPop(pVM->pStack);
408 ltoa((c).i, pVM->pad, pVM->base);
409 vmTextOut(pVM, pVM->pad, 0);
413 /* isdir? - Return whether an fd corresponds to a directory.
415 * isdir? ( fd -- bool )
417 static void isdirQuestion(FICL_VM *pVM)
424 vmCheckStack(pVM, 1, 1);
427 fd = stackPopINT(pVM->pStack);
432 if (fstat(fd, &sb) < 0)
434 if (!S_ISDIR(sb.st_mode))
438 stackPushINT(pVM->pStack, flag);
441 /* fopen - open a file and return new fd on stack.
443 * fopen ( ptr count mode -- fd )
445 static void pfopen(FICL_VM *pVM)
451 vmCheckStack(pVM, 3, 1);
454 mode = stackPopINT(pVM->pStack); /* get mode */
455 count = stackPopINT(pVM->pStack); /* get count */
456 ptr = stackPopPtr(pVM->pStack); /* get ptr */
458 if ((count < 0) || (ptr == NULL)) {
459 stackPushINT(pVM->pStack, -1);
463 /* ensure that the string is null terminated */
464 name = (char *)malloc(count+1);
465 bcopy(ptr,name,count);
469 fd = open(name, mode);
471 stackPushINT(pVM->pStack, fd);
475 /* fclose - close a file who's fd is on stack.
479 static void pfclose(FICL_VM *pVM)
484 vmCheckStack(pVM, 1, 0);
486 fd = stackPopINT(pVM->pStack); /* get fd */
492 /* fread - read file contents
494 * fread ( fd buf nbytes -- nread )
496 static void pfread(FICL_VM *pVM)
502 vmCheckStack(pVM, 3, 1);
504 len = stackPopINT(pVM->pStack); /* get number of bytes to read */
505 buf = stackPopPtr(pVM->pStack); /* get buffer */
506 fd = stackPopINT(pVM->pStack); /* get fd */
507 if (len > 0 && buf && fd != -1)
508 stackPushINT(pVM->pStack, read(fd, buf, len));
510 stackPushINT(pVM->pStack, -1);
514 /* freaddir - read directory contents
516 * freaddir ( fd -- ptr len TRUE | FALSE )
518 static void pfreaddir(FICL_VM *pVM)
521 static struct dirent dirent;
532 vmCheckStack(pVM, 1, 3);
535 fd = stackPopINT(pVM->pStack);
538 * The readdirfd() function is specific to the loader environment.
539 * We do the best we can to make freaddir work, but it's not at
547 if (fstat(fd, &sb) == -1)
549 blksz = (sb.st_blksize) ? sb.st_blksize : getpagesize();
550 if ((blksz & (blksz - 1)) != 0)
555 off = lseek(fd, 0LL, SEEK_CUR);
559 if (lseek(fd, 0, SEEK_SET) == -1)
561 bufsz = getdents(fd, buf, blksz);
562 while (bufsz > 0 && bufsz <= ptr) {
564 bufsz = getdents(fd, buf, blksz);
568 d = (void *)(buf + ptr);
571 d = (lseek(fd, off, SEEK_SET) != off) ? NULL : &dirent;
579 stackPushPtr(pVM->pStack, d->d_name);
580 stackPushINT(pVM->pStack, strlen(d->d_name));
581 stackPushINT(pVM->pStack, FICL_TRUE);
583 stackPushINT(pVM->pStack, FICL_FALSE);
587 /* fload - interpret file contents
591 static void pfload(FICL_VM *pVM)
596 vmCheckStack(pVM, 1, 0);
598 fd = stackPopINT(pVM->pStack); /* get fd */
604 /* fwrite - write file contents
606 * fwrite ( fd buf nbytes -- nwritten )
608 static void pfwrite(FICL_VM *pVM)
614 vmCheckStack(pVM, 3, 1);
616 len = stackPopINT(pVM->pStack); /* get number of bytes to read */
617 buf = stackPopPtr(pVM->pStack); /* get buffer */
618 fd = stackPopINT(pVM->pStack); /* get fd */
619 if (len > 0 && buf && fd != -1)
620 stackPushINT(pVM->pStack, write(fd, buf, len));
622 stackPushINT(pVM->pStack, -1);
626 /* fseek - seek to a new position in a file
628 * fseek ( fd ofs whence -- pos )
630 static void pfseek(FICL_VM *pVM)
635 vmCheckStack(pVM, 3, 1);
637 whence = stackPopINT(pVM->pStack);
638 pos = stackPopINT(pVM->pStack);
639 fd = stackPopINT(pVM->pStack);
640 stackPushINT(pVM->pStack, lseek(fd, pos, whence));
644 /* key - get a character from stdin
648 static void key(FICL_VM *pVM)
651 vmCheckStack(pVM, 0, 1);
653 stackPushINT(pVM->pStack, getchar());
657 /* key? - check for a character from stdin (FACILITY)
661 static void keyQuestion(FICL_VM *pVM)
664 vmCheckStack(pVM, 0, 1);
667 /* XXX Since we don't fiddle with termios, let it always succeed... */
668 stackPushINT(pVM->pStack, FICL_TRUE);
670 /* But here do the right thing. */
671 stackPushINT(pVM->pStack, ischar()? FICL_TRUE : FICL_FALSE);
676 /* seconds - gives number of seconds since beginning of time
678 * beginning of time is defined as:
680 * BTX - number of seconds since midnight
681 * FreeBSD - number of seconds since Jan 1 1970
685 static void pseconds(FICL_VM *pVM)
688 vmCheckStack(pVM,0,1);
690 stackPushUNS(pVM->pStack, (FICL_UNS) time(NULL));
694 /* ms - wait at least that many milliseconds (FACILITY)
699 static void ms(FICL_VM *pVM)
702 vmCheckStack(pVM,1,0);
705 usleep(stackPopUNS(pVM->pStack)*1000);
707 delay(stackPopUNS(pVM->pStack)*1000);
712 /* fkey - get a character from a file
714 * fkey ( file -- char )
716 static void fkey(FICL_VM *pVM)
722 vmCheckStack(pVM, 1, 1);
724 fd = stackPopINT(pVM->pStack);
725 i = read(fd, &ch, 1);
726 stackPushINT(pVM->pStack, i > 0 ? ch : -1);
731 ** Retrieves free space remaining on the dictionary
734 static void freeHeap(FICL_VM *pVM)
736 stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
740 /******************* Increase dictionary size on-demand ******************/
742 static void ficlDictThreshold(FICL_VM *pVM)
744 stackPushPtr(pVM->pStack, &dictThreshold);
747 static void ficlDictIncrease(FICL_VM *pVM)
749 stackPushPtr(pVM->pStack, &dictIncrease);
753 /**************************************************************************
754 f i c l C o m p i l e P l a t f o r m
755 ** Build FreeBSD platform extensions into the system dictionary
756 **************************************************************************/
757 void ficlCompilePlatform(FICL_SYSTEM *pSys)
759 FICL_DICT *dp = pSys->dp;
762 dictAppendWord(dp, ".#", displayCellNoPad, FW_DEFAULT);
763 dictAppendWord(dp, "isdir?", isdirQuestion, FW_DEFAULT);
764 dictAppendWord(dp, "fopen", pfopen, FW_DEFAULT);
765 dictAppendWord(dp, "fclose", pfclose, FW_DEFAULT);
766 dictAppendWord(dp, "fread", pfread, FW_DEFAULT);
767 dictAppendWord(dp, "freaddir", pfreaddir, FW_DEFAULT);
768 dictAppendWord(dp, "fload", pfload, FW_DEFAULT);
769 dictAppendWord(dp, "fkey", fkey, FW_DEFAULT);
770 dictAppendWord(dp, "fseek", pfseek, FW_DEFAULT);
771 dictAppendWord(dp, "fwrite", pfwrite, FW_DEFAULT);
772 dictAppendWord(dp, "key", key, FW_DEFAULT);
773 dictAppendWord(dp, "key?", keyQuestion, FW_DEFAULT);
774 dictAppendWord(dp, "ms", ms, FW_DEFAULT);
775 dictAppendWord(dp, "seconds", pseconds, FW_DEFAULT);
776 dictAppendWord(dp, "heap?", freeHeap, FW_DEFAULT);
777 dictAppendWord(dp, "dictthreshold", ficlDictThreshold, FW_DEFAULT);
778 dictAppendWord(dp, "dictincrease", ficlDictIncrease, FW_DEFAULT);
780 dictAppendWord(dp, "setenv", ficlSetenv, FW_DEFAULT);
781 dictAppendWord(dp, "setenv?", ficlSetenvq, FW_DEFAULT);
782 dictAppendWord(dp, "getenv", ficlGetenv, FW_DEFAULT);
783 dictAppendWord(dp, "unsetenv", ficlUnsetenv, FW_DEFAULT);
784 dictAppendWord(dp, "copyin", ficlCopyin, FW_DEFAULT);
785 dictAppendWord(dp, "copyout", ficlCopyout, FW_DEFAULT);
786 dictAppendWord(dp, "findfile", ficlFindfile, FW_DEFAULT);
787 dictAppendWord(dp, "ccall", ficlCcall, FW_DEFAULT);
790 dictAppendWord(dp, "outb", ficlOutb, FW_DEFAULT);
791 dictAppendWord(dp, "inb", ficlInb, FW_DEFAULT);
794 dictAppendWord(dp, "pnpdevices",ficlPnpdevices, FW_DEFAULT);
795 dictAppendWord(dp, "pnphandlers",ficlPnphandlers, FW_DEFAULT);
800 ficlSetEnv(pSys, "arch-pc98", FICL_TRUE);
801 #elif defined(__i386__)
802 ficlSetEnv(pSys, "arch-i386", FICL_TRUE);
803 ficlSetEnv(pSys, "arch-ia64", FICL_FALSE);
804 ficlSetEnv(pSys, "arch-powerpc", FICL_FALSE);
805 #elif defined(__ia64__)
806 ficlSetEnv(pSys, "arch-i386", FICL_FALSE);
807 ficlSetEnv(pSys, "arch-ia64", FICL_TRUE);
808 ficlSetEnv(pSys, "arch-powerpc", FICL_FALSE);
809 #elif defined(__powerpc__)
810 ficlSetEnv(pSys, "arch-i386", FICL_FALSE);
811 ficlSetEnv(pSys, "arch-ia64", FICL_FALSE);
812 ficlSetEnv(pSys, "arch-powerpc", FICL_TRUE);