interp_forth.c revision 40988
118334Speter/* 218334Speter * Copyright (c) 1998 Michael Smith <msmith@freebsd.org> 318334Speter * All rights reserved. 418334Speter * 518334Speter * Redistribution and use in source and binary forms, with or without 618334Speter * modification, are permitted provided that the following conditions 718334Speter * are met: 818334Speter * 1. Redistributions of source code must retain the above copyright 918334Speter * notice, this list of conditions and the following disclaimer. 1018334Speter * 2. Redistributions in binary form must reproduce the above copyright 1118334Speter * notice, this list of conditions and the following disclaimer in the 1218334Speter * documentation and/or other materials provided with the distribution. 1318334Speter * 1418334Speter * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 1518334Speter * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 1618334Speter * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 1718334Speter * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 1818334Speter * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 1918334Speter * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 2018334Speter * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 2118334Speter * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 2218334Speter * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 2318334Speter * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 2418334Speter * SUCH DAMAGE. 2518334Speter * 2618334Speter * $Id: interp_forth.c,v 1.6 1998/11/07 03:44:10 jkh Exp $ 2718334Speter */ 2818334Speter 2918334Speter#include <stand.h> 3018334Speter#include "bootstrap.h" 3118334Speter#include "ficl.h" 3218334Speter 3318334Speter/* #define BFORTH_DEBUG */ 3418334Speter 3518334Speter#ifdef BFORTH_DEBUG 3618334Speter# define DEBUG(fmt, args...) printf("%s: " fmt "\n" , __FUNCTION__ , ## args) 3718334Speter#else 3818334Speter# define DEBUG(fmt, args...) 3918334Speter#endif 4018334Speter 4118334Speter/* 4218334Speter * BootForth Interface to Ficl Forth interpreter. 4318334Speter */ 4418334Speter 4518334Speterstatic FICL_VM *bf_vm; 4618334Speter 4718334Speter/* 4818334Speter * Shim for taking commands from BF and passing them out to 'standard' 4918334Speter * argv/argc command functions. 5018334Speter */ 5118334Speterstatic void 5218334Speterbf_command(FICL_VM *vm) 5318334Speter{ 5418334Speter char *name, *line, *tail, *cp; 5518334Speter int len; 5618334Speter struct bootblk_command **cmdp; 5718334Speter bootblk_cmd_t *cmd; 5818334Speter int argc, result; 5918334Speter char **argv; 6018334Speter 6118334Speter /* Get the name of the current word */ 6218334Speter name = vm->runningWord->name; 6318334Speter 6418334Speter /* Find our command structure */ 6518334Speter cmd == NULL; 6618334Speter SET_FOREACH(cmdp, Xcommand_set) { 6718334Speter if (((*cmdp)->c_name != NULL) && !strcmp(name, (*cmdp)->c_name)) 6818334Speter cmd = (*cmdp)->c_fn; 6918334Speter } 7018334Speter if (cmd == NULL) 7118334Speter panic("callout for unknown command '%s'", name); 7218334Speter 7318334Speter /* Get remainder of invocation */ 7418334Speter tail = vmGetInBuf(vm); 7518334Speter for (cp = tail, len = 0; *cp != 0 && *cp != '\n'; cp++, len++) 7618334Speter ; 7718334Speter 7818334Speter line = malloc(strlen(name) + len + 2); 7918334Speter strcpy(line, name); 8018334Speter if (len > 0) { 8118334Speter strcat(line, " "); 8218334Speter strncat(line, tail, len); 8318334Speter vmUpdateTib(vm, tail + len); 8418334Speter } 8518334Speter DEBUG("cmd '%s'", line); 8618334Speter 8718334Speter command_errmsg = command_errbuf; 8818334Speter command_errbuf[0] = 0; 8918334Speter if (!parse(&argc, &argv, line)) { 9018334Speter result = (cmd)(argc, argv); 9118334Speter free(argv); 9218334Speter if (result != 0) { 9318334Speter strcpy(command_errmsg, vm->pad); 9418334Speter vmTextOut(vm, vm->pad, 1); 9518334Speter } 9618334Speter } else { 9718334Speter vmTextOut(vm, "parse error\n", 1); 9818334Speter } 9918334Speter free(line); 10018334Speter} 10118334Speter 10218334Speter/* 10318334Speter * Initialise the Forth interpreter, create all our commands as words. 10418334Speter */ 10518334Spetervoid 10618334Speterbf_init(void) 10718334Speter{ 10818334Speter struct bootblk_command **cmdp; 10918334Speter int fd; 11018334Speter 11118334Speter ficlInitSystem(4000); /* Default dictionary ~4000 cells */ 11218334Speter bf_vm = ficlNewVM(); 11318334Speter 11418334Speter /* make all commands appear as Forth words */ 11518334Speter SET_FOREACH(cmdp, Xcommand_set) 11618334Speter ficlBuild((*cmdp)->c_name, bf_command, FW_DEFAULT); 11718334Speter 11818334Speter /* try to load and run init file if present */ 11918334Speter if ((fd = open("/boot/boot.4th", O_RDONLY)) != -1) { 12018334Speter (void)ficlExecFD(bf_vm, fd); 12118334Speter close(fd); 12218334Speter } 12318334Speter} 12418334Speter 12518334Speter/* 12618334Speter * Feed a line of user input to the Forth interpreter 12718334Speter */ 12818334Spetervoid 12918334Speterbf_run(char *line) 13018334Speter{ 13118334Speter int result; 13218334Speter 13318334Speter result = ficlExec(bf_vm, line); 13418334Speter DEBUG("ficlExec '%s' = %d", line, result); 13518334Speter 13618334Speter if (result == VM_USEREXIT) 13718334Speter panic("interpreter exit"); 13818334Speter} 13918334Speter