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 *******************************************************************/
40 #include "bootstrap.h"
44 /* FreeBSD's loader interaction words and extras
46 * setenv ( value n name n' -- )
47 * setenv? ( value n name n' flag -- )
48 * getenv ( addr n -- addr' n' | -1 )
49 * unsetenv ( addr n -- )
50 * copyin ( addr addr' len -- )
51 * copyout ( addr addr' len -- )
52 * findfile ( name len type len' -- addr )
53 * pnpdevices ( -- addr )
54 * pnphandlers ( -- addr )
55 * ccall ( [[...[p10] p9] ... p1] n addr -- result )
60 ficlSetenv(FICL_VM *pVM)
69 vmCheckStack(pVM, 4, 0);
71 names = stackPopINT(pVM->pStack);
72 namep = (char*) stackPopPtr(pVM->pStack);
73 values = stackPopINT(pVM->pStack);
74 valuep = (char*) stackPopPtr(pVM->pStack);
77 name = (char*) ficlMalloc(names+1);
79 vmThrowErr(pVM, "Error: out of memory");
80 strncpy(name, namep, names);
82 value = (char*) ficlMalloc(values+1);
84 vmThrowErr(pVM, "Error: out of memory");
85 strncpy(value, valuep, values);
88 setenv(name, value, 1);
97 ficlSetenvq(FICL_VM *pVM)
102 char *namep, *valuep;
103 int names, values, overwrite;
106 vmCheckStack(pVM, 5, 0);
108 overwrite = stackPopINT(pVM->pStack);
109 names = stackPopINT(pVM->pStack);
110 namep = (char*) stackPopPtr(pVM->pStack);
111 values = stackPopINT(pVM->pStack);
112 valuep = (char*) stackPopPtr(pVM->pStack);
115 name = (char*) ficlMalloc(names+1);
117 vmThrowErr(pVM, "Error: out of memory");
118 strncpy(name, namep, names);
120 value = (char*) ficlMalloc(values+1);
122 vmThrowErr(pVM, "Error: out of memory");
123 strncpy(value, valuep, values);
124 value[values] = '\0';
126 setenv(name, value, overwrite);
135 ficlGetenv(FICL_VM *pVM)
144 vmCheckStack(pVM, 2, 2);
146 names = stackPopINT(pVM->pStack);
147 namep = (char*) stackPopPtr(pVM->pStack);
150 name = (char*) ficlMalloc(names+1);
152 vmThrowErr(pVM, "Error: out of memory");
153 strncpy(name, namep, names);
156 value = getenv(name);
160 stackPushPtr(pVM->pStack, value);
161 stackPushINT(pVM->pStack, strlen(value));
164 stackPushINT(pVM->pStack, -1);
170 ficlUnsetenv(FICL_VM *pVM)
179 vmCheckStack(pVM, 2, 0);
181 names = stackPopINT(pVM->pStack);
182 namep = (char*) stackPopPtr(pVM->pStack);
185 name = (char*) ficlMalloc(names+1);
187 vmThrowErr(pVM, "Error: out of memory");
188 strncpy(name, namep, names);
199 ficlCopyin(FICL_VM *pVM)
206 vmCheckStack(pVM, 3, 0);
209 len = stackPopINT(pVM->pStack);
210 dest = stackPopINT(pVM->pStack);
211 src = stackPopPtr(pVM->pStack);
214 archsw.arch_copyin(src, dest, len);
221 ficlCopyout(FICL_VM *pVM)
228 vmCheckStack(pVM, 3, 0);
231 len = stackPopINT(pVM->pStack);
232 dest = stackPopPtr(pVM->pStack);
233 src = stackPopINT(pVM->pStack);
236 archsw.arch_copyout(src, dest, len);
243 ficlFindfile(FICL_VM *pVM)
248 char *type, *namep, *typep;
249 struct preloaded_file* fp;
253 vmCheckStack(pVM, 4, 1);
256 types = stackPopINT(pVM->pStack);
257 typep = (char*) stackPopPtr(pVM->pStack);
258 names = stackPopINT(pVM->pStack);
259 namep = (char*) stackPopPtr(pVM->pStack);
261 name = (char*) ficlMalloc(names+1);
263 vmThrowErr(pVM, "Error: out of memory");
264 strncpy(name, namep, names);
266 type = (char*) ficlMalloc(types+1);
268 vmThrowErr(pVM, "Error: out of memory");
269 strncpy(type, typep, types);
272 fp = file_findfile(name, type);
276 stackPushPtr(pVM->pStack, fp);
285 ficlPnpdevices(FICL_VM *pVM)
287 static int pnp_devices_initted = 0;
289 vmCheckStack(pVM, 0, 1);
292 if(!pnp_devices_initted) {
293 STAILQ_INIT(&pnp_devices);
294 pnp_devices_initted = 1;
297 stackPushPtr(pVM->pStack, &pnp_devices);
303 ficlPnphandlers(FICL_VM *pVM)
306 vmCheckStack(pVM, 0, 1);
309 stackPushPtr(pVM->pStack, pnphandlers);
316 #endif /* ndef TESTMAIN */
319 ficlCcall(FICL_VM *pVM)
321 int (*func)(int, ...);
326 vmCheckStack(pVM, 2, 0);
329 func = stackPopPtr(pVM->pStack);
330 nparam = stackPopINT(pVM->pStack);
333 vmCheckStack(pVM, nparam, 1);
336 for (i = 0; i < nparam; i++)
337 p[i] = stackPopINT(pVM->pStack);
339 result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8],
342 stackPushINT(pVM->pStack, result);
347 /**************************************************************************
349 ** reads in text from file fd and passes it to ficlExec()
350 * returns VM_OUTOFTEXT on success or the ficlExec() error code on
354 int ficlExecFD(FICL_VM *pVM, int fd)
357 int nLine = 0, rval = VM_OUTOFTEXT;
362 pVM->sourceID.i = fd;
364 /* feed each line to ficlExec */
369 while ((status = read(fd, &ch, 1)) > 0 && ch != '\n')
377 rval = ficlExecC(pVM, cp, i);
378 if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT)
385 ** Pass an empty line with SOURCE-ID == -1 to flush
386 ** any pending REFILLs (as required by FILE wordset)
388 pVM->sourceID.i = -1;
395 static void displayCellNoPad(FICL_VM *pVM)
399 vmCheckStack(pVM, 1, 0);
401 c = stackPop(pVM->pStack);
402 ltoa((c).i, pVM->pad, pVM->base);
403 vmTextOut(pVM, pVM->pad, 0);
407 /* fopen - open a file and return new fd on stack.
409 * fopen ( ptr count mode -- fd )
411 static void pfopen(FICL_VM *pVM)
417 vmCheckStack(pVM, 3, 1);
420 mode = stackPopINT(pVM->pStack); /* get mode */
421 count = stackPopINT(pVM->pStack); /* get count */
422 ptr = stackPopPtr(pVM->pStack); /* get ptr */
424 if ((count < 0) || (ptr == NULL)) {
425 stackPushINT(pVM->pStack, -1);
429 /* ensure that the string is null terminated */
430 name = (char *)malloc(count+1);
431 bcopy(ptr,name,count);
435 fd = open(name, mode);
437 stackPushINT(pVM->pStack, fd);
441 /* fclose - close a file who's fd is on stack.
445 static void pfclose(FICL_VM *pVM)
450 vmCheckStack(pVM, 1, 0);
452 fd = stackPopINT(pVM->pStack); /* get fd */
458 /* fread - read file contents
460 * fread ( fd buf nbytes -- nread )
462 static void pfread(FICL_VM *pVM)
468 vmCheckStack(pVM, 3, 1);
470 len = stackPopINT(pVM->pStack); /* get number of bytes to read */
471 buf = stackPopPtr(pVM->pStack); /* get buffer */
472 fd = stackPopINT(pVM->pStack); /* get fd */
473 if (len > 0 && buf && fd != -1)
474 stackPushINT(pVM->pStack, read(fd, buf, len));
476 stackPushINT(pVM->pStack, -1);
480 /* fload - interpret file contents
484 static void pfload(FICL_VM *pVM)
489 vmCheckStack(pVM, 1, 0);
491 fd = stackPopINT(pVM->pStack); /* get fd */
497 /* fwrite - write file contents
499 * fwrite ( fd buf nbytes -- nwritten )
501 static void pfwrite(FICL_VM *pVM)
507 vmCheckStack(pVM, 3, 1);
509 len = stackPopINT(pVM->pStack); /* get number of bytes to read */
510 buf = stackPopPtr(pVM->pStack); /* get buffer */
511 fd = stackPopINT(pVM->pStack); /* get fd */
512 if (len > 0 && buf && fd != -1)
513 stackPushINT(pVM->pStack, write(fd, buf, len));
515 stackPushINT(pVM->pStack, -1);
519 /* fseek - seek to a new position in a file
521 * fseek ( fd ofs whence -- pos )
523 static void pfseek(FICL_VM *pVM)
528 vmCheckStack(pVM, 3, 1);
530 whence = stackPopINT(pVM->pStack);
531 pos = stackPopINT(pVM->pStack);
532 fd = stackPopINT(pVM->pStack);
533 stackPushINT(pVM->pStack, lseek(fd, pos, whence));
537 /* key - get a character from stdin
541 static void key(FICL_VM *pVM)
544 vmCheckStack(pVM, 0, 1);
546 stackPushINT(pVM->pStack, getchar());
550 /* key? - check for a character from stdin (FACILITY)
554 static void keyQuestion(FICL_VM *pVM)
557 vmCheckStack(pVM, 0, 1);
560 /* XXX Since we don't fiddle with termios, let it always succeed... */
561 stackPushINT(pVM->pStack, FICL_TRUE);
563 /* But here do the right thing. */
564 stackPushINT(pVM->pStack, ischar()? FICL_TRUE : FICL_FALSE);
569 /* seconds - gives number of seconds since beginning of time
571 * beginning of time is defined as:
573 * BTX - number of seconds since midnight
574 * FreeBSD - number of seconds since Jan 1 1970
578 static void pseconds(FICL_VM *pVM)
581 vmCheckStack(pVM,0,1);
583 stackPushUNS(pVM->pStack, (FICL_UNS) time(NULL));
587 /* ms - wait at least that many milliseconds (FACILITY)
592 static void ms(FICL_VM *pVM)
595 vmCheckStack(pVM,1,0);
598 usleep(stackPopUNS(pVM->pStack)*1000);
600 delay(stackPopUNS(pVM->pStack)*1000);
605 /* fkey - get a character from a file
607 * fkey ( file -- char )
609 static void fkey(FICL_VM *pVM)
615 vmCheckStack(pVM, 1, 1);
617 fd = stackPopINT(pVM->pStack);
618 i = read(fd, &ch, 1);
619 stackPushINT(pVM->pStack, i > 0 ? ch : -1);
624 ** Retrieves free space remaining on the dictionary
627 static void freeHeap(FICL_VM *pVM)
629 stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
633 /******************* Increase dictionary size on-demand ******************/
635 static void ficlDictThreshold(FICL_VM *pVM)
637 stackPushPtr(pVM->pStack, &dictThreshold);
640 static void ficlDictIncrease(FICL_VM *pVM)
642 stackPushPtr(pVM->pStack, &dictIncrease);
646 /**************************************************************************
647 f i c l C o m p i l e P l a t f o r m
648 ** Build FreeBSD platform extensions into the system dictionary
649 **************************************************************************/
650 void ficlCompilePlatform(FICL_SYSTEM *pSys)
652 FICL_DICT *dp = pSys->dp;
655 dictAppendWord(dp, ".#", displayCellNoPad, FW_DEFAULT);
656 dictAppendWord(dp, "fopen", pfopen, FW_DEFAULT);
657 dictAppendWord(dp, "fclose", pfclose, FW_DEFAULT);
658 dictAppendWord(dp, "fread", pfread, FW_DEFAULT);
659 dictAppendWord(dp, "fload", pfload, FW_DEFAULT);
660 dictAppendWord(dp, "fkey", fkey, FW_DEFAULT);
661 dictAppendWord(dp, "fseek", pfseek, FW_DEFAULT);
662 dictAppendWord(dp, "fwrite", pfwrite, FW_DEFAULT);
663 dictAppendWord(dp, "key", key, FW_DEFAULT);
664 dictAppendWord(dp, "key?", keyQuestion, FW_DEFAULT);
665 dictAppendWord(dp, "ms", ms, FW_DEFAULT);
666 dictAppendWord(dp, "seconds", pseconds, FW_DEFAULT);
667 dictAppendWord(dp, "heap?", freeHeap, FW_DEFAULT);
668 dictAppendWord(dp, "dictthreshold", ficlDictThreshold, FW_DEFAULT);
669 dictAppendWord(dp, "dictincrease", ficlDictIncrease, FW_DEFAULT);
671 dictAppendWord(dp, "setenv", ficlSetenv, FW_DEFAULT);
672 dictAppendWord(dp, "setenv?", ficlSetenvq, FW_DEFAULT);
673 dictAppendWord(dp, "getenv", ficlGetenv, FW_DEFAULT);
674 dictAppendWord(dp, "unsetenv", ficlUnsetenv, FW_DEFAULT);
675 dictAppendWord(dp, "copyin", ficlCopyin, FW_DEFAULT);
676 dictAppendWord(dp, "copyout", ficlCopyout, FW_DEFAULT);
677 dictAppendWord(dp, "findfile", ficlFindfile, FW_DEFAULT);
678 dictAppendWord(dp, "ccall", ficlCcall, FW_DEFAULT);
681 dictAppendWord(dp, "outb", ficlOutb, FW_DEFAULT);
682 dictAppendWord(dp, "inb", ficlInb, FW_DEFAULT);
685 dictAppendWord(dp, "pnpdevices",ficlPnpdevices, FW_DEFAULT);
686 dictAppendWord(dp, "pnphandlers",ficlPnphandlers, FW_DEFAULT);
691 ficlSetEnv(pSys, "arch-pc98", FICL_TRUE);
692 #elif defined(__i386__)
693 ficlSetEnv(pSys, "arch-i386", FICL_TRUE);
694 ficlSetEnv(pSys, "arch-ia64", FICL_FALSE);
695 ficlSetEnv(pSys, "arch-powerpc", FICL_FALSE);
696 #elif defined(__ia64__)
697 ficlSetEnv(pSys, "arch-i386", FICL_FALSE);
698 ficlSetEnv(pSys, "arch-ia64", FICL_TRUE);
699 ficlSetEnv(pSys, "arch-powerpc", FICL_FALSE);
700 #elif defined(__powerpc__)
701 ficlSetEnv(pSys, "arch-i386", FICL_FALSE);
702 ficlSetEnv(pSys, "arch-ia64", FICL_FALSE);
703 ficlSetEnv(pSys, "arch-powerpc", FICL_TRUE);