/*
 * Copyright (c) 1998 Michael Smith <msmith@freebsd.org>
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

#include <sys/cdefs.h>

#include <sys/param.h>		/* to pick up __FreeBSD_version */
#include <string.h>
#include <stand.h>
#include "bootstrap.h"
#include "ficl.h"

extern unsigned bootprog_rev;

/* #define BFORTH_DEBUG */

#ifdef BFORTH_DEBUG
#define	DPRINTF(fmt, args...)	printf("%s: " fmt "\n", __func__, ## args)
#else
#define	DPRINTF(fmt, args...)	((void)0)
#endif

/*
 * Eventually, all builtin commands throw codes must be defined
 * elsewhere, possibly bootstrap.h. For now, just this code, used
 * just in this file, it is getting defined.
 */
#define	BF_PARSE 100

/*
 * FreeBSD loader default dictionary cells
 */
#ifndef	BF_DICTSIZE
#define	BF_DICTSIZE	30000
#endif

/*
 * BootForth   Interface to Ficl Forth interpreter.
 */

ficlSystemInformation *fsi;
ficlSystem *bf_sys;
ficlVm	*bf_vm;

/*
 * Shim for taking commands from BF and passing them out to 'standard'
 * argv/argc command functions.
 */
static void
bf_command(ficlVm *vm)
{
	char			*name, *line, *tail, *cp;
	size_t			len;
	struct bootblk_command	**cmdp;
	bootblk_cmd_t		*cmd;
	int			nstrings, i;
	int			argc, result;
	char			**argv;

	/* Get the name of the current word */
	name = vm->runningWord->name;

	/* Find our command structure */
	cmd = NULL;
	SET_FOREACH(cmdp, Xcommand_set) {
		if (((*cmdp)->c_name != NULL) &&
		    strcmp(name, (*cmdp)->c_name) == 0)
			cmd = (*cmdp)->c_fn;
	}
	if (cmd == NULL)
		panic("callout for unknown command '%s'", name);

	/* Check whether we have been compiled or are being interpreted */
	if (ficlStackPopInteger(ficlVmGetDataStack(vm))) {
		/*
		 * Get parameters from stack, in the format:
		 * an un ... a2 u2 a1 u1 n --
		 * Where n is the number of strings, a/u are pairs of
		 * address/size for strings, and they will be concatenated
		 * in LIFO order.
		 */
		nstrings = ficlStackPopInteger(ficlVmGetDataStack(vm));
		for (i = 0, len = 0; i < nstrings; i++) {
			ficlStack *stack = ficlVmGetDataStack(vm);
			len += ficlStackFetch(stack, i * 2).i + 1;
		}
		line = malloc(strlen(name) + len + 1);
		strcpy(line, name);

		if (nstrings)
			for (i = 0; i < nstrings; i++) {
				ficlStack *stack = ficlVmGetDataStack(vm);

				len = ficlStackPopInteger(stack);
				cp = ficlStackPopPointer(stack);
				strcat(line, " ");
				strncat(line, cp, len);
			}
	} else {
		/* Get remainder of invocation */
		tail = ficlVmGetInBuf(vm);

		len = 0;
		cp = tail;
		for (; cp != vm->tib.end && *cp != 0 && *cp != '\n'; cp++)
			len++;

		line = malloc(strlen(name) + len + 2);
		strcpy(line, name);
		if (len > 0) {
			strcat(line, " ");
			strncat(line, tail, len);
			ficlVmUpdateTib(vm, tail + len);
		}
	}
	DPRINTF("cmd '%s'", line);

	command_errmsg = command_errbuf;
	command_errbuf[0] = 0;
	if (!parse(&argc, &argv, line)) {
		result = (cmd)(argc, argv);
		free(argv);
	} else {
		result = BF_PARSE;
	}

	switch (result) {
	case CMD_CRIT:
		printf("%s\n", command_errmsg);
		command_errmsg = NULL;
		break;
	case CMD_FATAL:
		panic("%s", command_errmsg);
	}

	free(line);
	/*
	 * If there was error during nested ficlExec(), we may no longer have
	 * valid environment to return.  Throw all exceptions from here.
	 */
	if (result != CMD_OK)
		ficlVmThrow(vm, result);

	/* This is going to be thrown!!! */
	ficlStackPushInteger(ficlVmGetDataStack(vm), result);
}

/*
 * Replace a word definition (a builtin command) with another
 * one that:
 *
 *        - Throw error results instead of returning them on the stack
 *        - Pass a flag indicating whether the word was compiled or is
 *          being interpreted.
 *
 * There is one major problem with builtins that cannot be overcome
 * in anyway, except by outlawing it. We want builtins to behave
 * differently depending on whether they have been compiled or they
 * are being interpreted. Notice that this is *not* the interpreter's
 * current state. For example:
 *
 * : example ls ; immediate
 * : problem example ;		\ "ls" gets executed while compiling
 * example			\ "ls" gets executed while interpreting
 *
 * Notice that, though the current state is different in the two
 * invocations of "example", in both cases "ls" has been
 * *compiled in*, which is what we really want.
 *
 * The problem arises when you tick the builtin. For example:
 *
 * : example-1 ['] ls postpone literal ; immediate
 * : example-2 example-1 execute ; immediate
 * : problem example-2 ;
 * example-2
 *
 * We have no way, when we get EXECUTEd, of knowing what our behavior
 * should be. Thus, our only alternative is to "outlaw" this. See RFI
 * 0007, and ANS Forth Standard's appendix D, item 6.7 for a related
 * problem, concerning compile semantics.
 *
 * The problem is compounded by the fact that "' builtin CATCH" is valid
 * and desirable. The only solution is to create an intermediary word.
 * For example:
 *
 * : my-ls ls ;
 * : example ['] my-ls catch ;
 *
 * So, with the below implementation, here is a summary of the behavior
 * of builtins:
 *
 * ls -l				\ "interpret" behavior, ie,
 *					\ takes parameters from TIB
 * : ex-1 s" -l" 1 ls ;			\ "compile" behavior, ie,
 *					\ takes parameters from the stack
 * : ex-2 ['] ls catch ; immediate	\ undefined behavior
 * : ex-3 ['] ls catch ;		\ undefined behavior
 * ex-2 ex-3				\ "interpret" behavior,
 *					\ catch works
 * : ex-4 ex-2 ;			\ "compile" behavior,
 *					\ catch does not work
 * : ex-5 ex-3 ; immediate		\ same as ex-2
 * : ex-6 ex-3 ;			\ same as ex-3
 * : ex-7 ['] ex-1 catch ;		\ "compile" behavior,
 *					\ catch works
 * : ex-8 postpone ls ;	immediate	\ same as ex-2
 * : ex-9 postpone ls ;			\ same as ex-3
 *
 * As the definition below is particularly tricky, and it's side effects
 * must be well understood by those playing with it, I'll be heavy on
 * the comments.
 *
 * (if you edit this definition, pay attention to trailing spaces after
 *  each word -- I warned you! :-) )
 */
#define	BUILTIN_CONSTRUCTOR \
": builtin: "		\
	">in @ "		/* save the tib index pointer */ \
	"' "			/* get next word's xt */ \
	"swap >in ! "		/* point again to next word */ \
	"create "		/* create a new definition of the next word */ \
	", "			/* save previous definition's xt */ \
	"immediate "	/* make the new definition an immediate word */ \
			\
	"does> "		/* Now, the *new* definition will: */ \
	"state @ if "		/* if in compiling state: */ \
	"1 postpone literal "	/* pass 1 flag to indicate compile */ \
	"@ compile, "		/* compile in previous definition */ \
	"postpone throw "	/* throw stack-returned result */ \
	"else "		/* if in interpreting state: */ \
	"0 swap "		/* pass 0 flag to indicate interpret */ \
	"@ execute "		/* call previous definition */ \
	"throw "			/* throw stack-returned result */ \
	"then ; "

/*
 * Initialise the Forth interpreter, create all our commands as words.
 */
void
bf_init(char *rc)
{
	struct bootblk_command	**cmdp;
	char create_buf[41];	/* 31 characters-long builtins */
	int fd, rv;
	ficlDictionary *dict;
	ficlDictionary *env;

	fsi = malloc(sizeof (ficlSystemInformation));
	ficlSystemInformationInitialize(fsi);
	fsi->dictionarySize = BF_DICTSIZE;

	bf_sys = ficlSystemCreate(fsi);
	bf_vm = ficlSystemCreateVm(bf_sys);

	/* Put all private definitions in a "builtins" vocabulary */
	rv = ficlVmEvaluate(bf_vm,
	    "vocabulary builtins also builtins definitions");
	if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
		panic("error interpreting forth: %d", rv);
	}

	/* Builtin constructor word  */
	rv = ficlVmEvaluate(bf_vm, BUILTIN_CONSTRUCTOR);
	if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
		panic("error interpreting forth: %d", rv);
	}

	/* make all commands appear as Forth words */
	dict = ficlSystemGetDictionary(bf_sys);
	SET_FOREACH(cmdp, Xcommand_set) {
		ficlDictionaryAppendPrimitive(dict, (char *)(*cmdp)->c_name,
		    bf_command, FICL_WORD_DEFAULT);
		rv = ficlVmEvaluate(bf_vm, "forth definitions builtins");
		if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
			panic("error interpreting forth: %d", rv);
		}
		sprintf(create_buf, "builtin: %s", (*cmdp)->c_name);
		rv = ficlVmEvaluate(bf_vm, create_buf);
		if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
			panic("error interpreting forth: %d", rv);
		}
		rv = ficlVmEvaluate(bf_vm, "builtins definitions");
		if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
			panic("error interpreting forth: %d", rv);
		}
	}
	rv = ficlVmEvaluate(bf_vm, "only forth definitions");
	if (rv != FICL_VM_STATUS_OUT_OF_TEXT) {
		panic("error interpreting forth: %d", rv);
	}

	/*
	 * Export some version numbers so that code can detect the loader/host
	 * version
	 */
	env = ficlSystemGetEnvironment(bf_sys);
	ficlDictionarySetConstant(env, "loader_version", bootprog_rev);

	/* try to load and run init file if present */
	if (rc == NULL)
		rc = "/boot/forth/boot.4th";
	if (*rc != '\0') {
		fd = open(rc, O_RDONLY);
		if (fd != -1) {
			(void) ficlExecFD(bf_vm, fd);
			close(fd);
		}
	}
}

/*
 * Feed a line of user input to the Forth interpreter
 */
int
bf_run(char *line)
{
	int result;
	ficlString s;

	FICL_STRING_SET_FROM_CSTRING(s, line);
	result = ficlVmExecuteString(bf_vm, s);

	DPRINTF("ficlExec '%s' = %d", line, result);
	switch (result) {
	case FICL_VM_STATUS_OUT_OF_TEXT:
	case FICL_VM_STATUS_ABORTQ:
	case FICL_VM_STATUS_QUIT:
	case FICL_VM_STATUS_ERROR_EXIT:
		break;
	case FICL_VM_STATUS_USER_EXIT:
		printf("No where to leave to!\n");
		break;
	case FICL_VM_STATUS_ABORT:
		printf("Aborted!\n");
		break;
	case BF_PARSE:
		printf("Parse error!\n");
		break;
	default:
		if (command_errmsg != NULL) {
			printf("%s\n", command_errmsg);
			command_errmsg = NULL;
		}
	}

	/* bye is same as reboot and will behave depending on platform */
	if (result == FICL_VM_STATUS_USER_EXIT)
		bf_run("reboot");
	setenv("interpret", bf_vm->state ? "" : "ok", 1);

	return (result);
}