The Design and Implementation of the FreeBSD Operating System, Second Edition
Now available: The Design and Implementation of the FreeBSD Operating System, Second Edition

[ source navigation ] [ diff markup ] [ identifier search ] [ freetext search ] [ file search ] [ list types ] [ track identifier ]

FreeBSD/Linux Kernel Cross Reference
sys/boot/common/interp_forth.c

Version: -  FREEBSD  -  FREEBSD10  -  FREEBSD9  -  FREEBSD92  -  FREEBSD91  -  FREEBSD90  -  FREEBSD8  -  FREEBSD82  -  FREEBSD81  -  FREEBSD80  -  FREEBSD7  -  FREEBSD74  -  FREEBSD73  -  FREEBSD72  -  FREEBSD71  -  FREEBSD70  -  FREEBSD6  -  FREEBSD64  -  FREEBSD63  -  FREEBSD62  -  FREEBSD61  -  FREEBSD60  -  FREEBSD5  -  FREEBSD55  -  FREEBSD54  -  FREEBSD53  -  FREEBSD52  -  FREEBSD51  -  FREEBSD50  -  FREEBSD4  -  FREEBSD3  -  FREEBSD22  -  linux-2.6  -  linux-2.4.22  -  MK83  -  MK84  -  PLAN9  -  DFBSD  -  NETBSD  -  NETBSD5  -  NETBSD4  -  NETBSD3  -  NETBSD20  -  OPENBSD  -  xnu-517  -  xnu-792  -  xnu-792.6.70  -  xnu-1228  -  xnu-1456.1.26  -  xnu-1699.24.8  -  xnu-2050.18.24  -  OPENSOLARIS  -  minix-3-1-1 
SearchContext: -  none  -  3  -  10 

    1 /*-
    2  * Copyright (c) 1998 Michael Smith <msmith@freebsd.org>
    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 #include <sys/cdefs.h>
   28 __FBSDID("$FreeBSD: stable/9/sys/boot/common/interp_forth.c 119483 2003-08-25 23:30:41Z obrien $");
   29 
   30 #include <sys/param.h>          /* to pick up __FreeBSD_version */
   31 #include <string.h>
   32 #include <stand.h>
   33 #include "bootstrap.h"
   34 #include "ficl.h"
   35 
   36 extern char bootprog_rev[];
   37 
   38 /* #define BFORTH_DEBUG */
   39 
   40 #ifdef BFORTH_DEBUG
   41 # define DEBUG(fmt, args...)    printf("%s: " fmt "\n" , __func__ , ## args)
   42 #else
   43 # define DEBUG(fmt, args...)
   44 #endif
   45 
   46 /*
   47  * Eventually, all builtin commands throw codes must be defined
   48  * elsewhere, possibly bootstrap.h. For now, just this code, used
   49  * just in this file, it is getting defined.
   50  */
   51 #define BF_PARSE 100
   52 
   53 /*
   54  * BootForth   Interface to Ficl Forth interpreter.
   55  */
   56 
   57 FICL_SYSTEM *bf_sys;
   58 FICL_VM *bf_vm;
   59 FICL_WORD *pInterp;
   60 
   61 /*
   62  * Shim for taking commands from BF and passing them out to 'standard'
   63  * argv/argc command functions.
   64  */
   65 static void
   66 bf_command(FICL_VM *vm)
   67 {
   68     char                        *name, *line, *tail, *cp;
   69     size_t                      len;
   70     struct bootblk_command      **cmdp;
   71     bootblk_cmd_t               *cmd;
   72     int                         nstrings, i;
   73     int                         argc, result;
   74     char                        **argv;
   75 
   76     /* Get the name of the current word */
   77     name = vm->runningWord->name;
   78     
   79     /* Find our command structure */
   80     cmd = NULL;
   81     SET_FOREACH(cmdp, Xcommand_set) {
   82         if (((*cmdp)->c_name != NULL) && !strcmp(name, (*cmdp)->c_name))
   83             cmd = (*cmdp)->c_fn;
   84     }
   85     if (cmd == NULL)
   86         panic("callout for unknown command '%s'", name);
   87    
   88     /* Check whether we have been compiled or are being interpreted */
   89     if (stackPopINT(vm->pStack)) {
   90         /*
   91          * Get parameters from stack, in the format:
   92          * an un ... a2 u2 a1 u1 n --
   93          * Where n is the number of strings, a/u are pairs of
   94          * address/size for strings, and they will be concatenated
   95          * in LIFO order.
   96          */
   97         nstrings = stackPopINT(vm->pStack);
   98         for (i = 0, len = 0; i < nstrings; i++)
   99             len += stackFetch(vm->pStack, i * 2).i + 1;
  100         line = malloc(strlen(name) + len + 1);
  101         strcpy(line, name);
  102 
  103         if (nstrings)
  104             for (i = 0; i < nstrings; i++) {
  105                 len = stackPopINT(vm->pStack);
  106                 cp = stackPopPtr(vm->pStack);
  107                 strcat(line, " ");
  108                 strncat(line, cp, len);
  109             }
  110     } else {
  111         /* Get remainder of invocation */
  112         tail = vmGetInBuf(vm);
  113         for (cp = tail, len = 0; cp != vm->tib.end && *cp != 0 && *cp != '\n'; cp++, len++)
  114             ;
  115     
  116         line = malloc(strlen(name) + len + 2);
  117         strcpy(line, name);
  118         if (len > 0) {
  119             strcat(line, " ");
  120             strncat(line, tail, len);
  121             vmUpdateTib(vm, tail + len);
  122         }
  123     }
  124     DEBUG("cmd '%s'", line);
  125     
  126     command_errmsg = command_errbuf;
  127     command_errbuf[0] = 0;
  128     if (!parse(&argc, &argv, line)) {
  129         result = (cmd)(argc, argv);
  130         free(argv);
  131     } else {
  132         result=BF_PARSE;
  133     }
  134     free(line);
  135     /* This is going to be thrown!!! */
  136     stackPushINT(vm->pStack,result);
  137 }
  138 
  139 /*
  140  * Replace a word definition (a builtin command) with another
  141  * one that:
  142  *
  143  *        - Throw error results instead of returning them on the stack
  144  *        - Pass a flag indicating whether the word was compiled or is
  145  *          being interpreted.
  146  *
  147  * There is one major problem with builtins that cannot be overcome
  148  * in anyway, except by outlawing it. We want builtins to behave
  149  * differently depending on whether they have been compiled or they
  150  * are being interpreted. Notice that this is *not* the interpreter's
  151  * current state. For example:
  152  *
  153  * : example ls ; immediate
  154  * : problem example ;          \ "ls" gets executed while compiling
  155  * example                      \ "ls" gets executed while interpreting
  156  *
  157  * Notice that, though the current state is different in the two
  158  * invocations of "example", in both cases "ls" has been
  159  * *compiled in*, which is what we really want.
  160  *
  161  * The problem arises when you tick the builtin. For example:
  162  *
  163  * : example-1 ['] ls postpone literal ; immediate
  164  * : example-2 example-1 execute ; immediate
  165  * : problem example-2 ;
  166  * example-2
  167  *
  168  * We have no way, when we get EXECUTEd, of knowing what our behavior
  169  * should be. Thus, our only alternative is to "outlaw" this. See RFI
  170  * 0007, and ANS Forth Standard's appendix D, item 6.7 for a related
  171  * problem, concerning compile semantics.
  172  *
  173  * The problem is compounded by the fact that "' builtin CATCH" is valid
  174  * and desirable. The only solution is to create an intermediary word.
  175  * For example:
  176  *
  177  * : my-ls ls ;
  178  * : example ['] my-ls catch ;
  179  *
  180  * So, with the below implementation, here is a summary of the behavior
  181  * of builtins:
  182  *
  183  * ls -l                                \ "interpret" behavior, ie,
  184  *                                      \ takes parameters from TIB
  185  * : ex-1 s" -l" 1 ls ;                 \ "compile" behavior, ie,
  186  *                                      \ takes parameters from the stack
  187  * : ex-2 ['] ls catch ; immediate      \ undefined behavior
  188  * : ex-3 ['] ls catch ;                \ undefined behavior
  189  * ex-2 ex-3                            \ "interpret" behavior,
  190  *                                      \ catch works
  191  * : ex-4 ex-2 ;                        \ "compile" behavior,
  192  *                                      \ catch does not work
  193  * : ex-5 ex-3 ; immediate              \ same as ex-2
  194  * : ex-6 ex-3 ;                        \ same as ex-3
  195  * : ex-7 ['] ex-1 catch ;              \ "compile" behavior,
  196  *                                      \ catch works
  197  * : ex-8 postpone ls ; immediate       \ same as ex-2
  198  * : ex-9 postpone ls ;                 \ same as ex-3
  199  *
  200  * As the definition below is particularly tricky, and it's side effects
  201  * must be well understood by those playing with it, I'll be heavy on
  202  * the comments.
  203  *
  204  * (if you edit this definition, pay attention to trailing spaces after
  205  *  each word -- I warned you! :-) )
  206  */
  207 #define BUILTIN_CONSTRUCTOR \
  208 ": builtin: "           \
  209   ">in @ "              /* save the tib index pointer */ \
  210   "' "                  /* get next word's xt */ \
  211   "swap >in ! "         /* point again to next word */ \
  212   "create "             /* create a new definition of the next word */ \
  213   ", "                  /* save previous definition's xt */ \
  214   "immediate "          /* make the new definition an immediate word */ \
  215                         \
  216   "does> "              /* Now, the *new* definition will: */ \
  217   "state @ if "         /* if in compiling state: */ \
  218     "1 postpone literal "       /* pass 1 flag to indicate compile */ \
  219     "@ compile, "               /* compile in previous definition */ \
  220     "postpone throw "           /* throw stack-returned result */ \
  221   "else "               /* if in interpreting state: */ \
  222     "0 swap "                   /* pass 0 flag to indicate interpret */ \
  223     "@ execute "                /* call previous definition */ \
  224     "throw "                    /* throw stack-returned result */ \
  225   "then ; "
  226 
  227 /*
  228  * Initialise the Forth interpreter, create all our commands as words.
  229  */
  230 void
  231 bf_init(void)
  232 {
  233     struct bootblk_command      **cmdp;
  234     char create_buf[41];        /* 31 characters-long builtins */
  235     int fd;
  236    
  237     bf_sys = ficlInitSystem(10000);     /* Default dictionary ~4000 cells */
  238     bf_vm = ficlNewVM(bf_sys);
  239 
  240     /* Put all private definitions in a "builtins" vocabulary */
  241     ficlExec(bf_vm, "vocabulary builtins also builtins definitions");
  242 
  243     /* Builtin constructor word  */
  244     ficlExec(bf_vm, BUILTIN_CONSTRUCTOR);
  245 
  246     /* make all commands appear as Forth words */
  247     SET_FOREACH(cmdp, Xcommand_set) {
  248         ficlBuild(bf_sys, (char *)(*cmdp)->c_name, bf_command, FW_DEFAULT);
  249         ficlExec(bf_vm, "forth definitions builtins");
  250         sprintf(create_buf, "builtin: %s", (*cmdp)->c_name);
  251         ficlExec(bf_vm, create_buf);
  252         ficlExec(bf_vm, "builtins definitions");
  253     }
  254     ficlExec(bf_vm, "only forth definitions");
  255 
  256     /* Export some version numbers so that code can detect the loader/host version */
  257     ficlSetEnv(bf_sys, "FreeBSD_version", __FreeBSD_version);
  258     ficlSetEnv(bf_sys, "loader_version", 
  259                (bootprog_rev[0] - '') * 10 + (bootprog_rev[2] - ''));
  260 
  261     /* try to load and run init file if present */
  262     if ((fd = open("/boot/boot.4th", O_RDONLY)) != -1) {
  263         (void)ficlExecFD(bf_vm, fd);
  264         close(fd);
  265     }
  266 
  267     /* Do this last, so /boot/boot.4th can change it */
  268     pInterp = ficlLookup(bf_sys, "interpret");
  269 }
  270 
  271 /*
  272  * Feed a line of user input to the Forth interpreter
  273  */
  274 int
  275 bf_run(char *line)
  276 {
  277     int         result;
  278 
  279     result = ficlExec(bf_vm, line);
  280 
  281     DEBUG("ficlExec '%s' = %d", line, result);
  282     switch (result) {
  283     case VM_OUTOFTEXT:
  284     case VM_ABORTQ:
  285     case VM_QUIT:
  286     case VM_ERREXIT:
  287         break;
  288     case VM_USEREXIT:
  289         printf("No where to leave to!\n");
  290         break;
  291     case VM_ABORT:
  292         printf("Aborted!\n");
  293         break;
  294     case BF_PARSE:
  295         printf("Parse error!\n");
  296         break;
  297     default:
  298         /* Hopefully, all other codes filled this buffer */
  299         printf("%s\n", command_errmsg);
  300     }
  301     
  302     if (result == VM_USEREXIT)
  303         panic("interpreter exit");
  304     setenv("interpret", bf_vm->state ? "" : "OK", 1);
  305 
  306     return result;
  307 }

Cache object: a0d40c2912c4f6a28ecbf498c4428e0e


[ source navigation ] [ diff markup ] [ identifier search ] [ freetext search ] [ file search ] [ list types ] [ track identifier ]


This page is part of the FreeBSD/Linux Linux Kernel Cross-Reference, and was automatically generated using a modified version of the LXR engine.