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