xref: /illumos-gate/usr/src/lib/efcode/engine/debug.c (revision 09e6639b)

/*
 * CDDL HEADER START
 *
 * The contents of this file are subject to the terms of the
 * Common Development and Distribution License, Version 1.0 only
 * (the "License").  You may not use this file except in compliance
 * with the License.
 *
 * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
 * or http://www.opensolaris.org/os/licensing.
 * See the License for the specific language governing permissions
 * and limitations under the License.
 *
 * When distributing Covered Code, include this CDDL HEADER in each
 * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
 * If applicable, add the following below this CDDL HEADER, with the
 * fields enclosed by brackets "[]" replaced with your own identifying
 * information: Portions Copyright [yyyy] [name of copyright owner]
 *
 * CDDL HEADER END
 */
/*
 * Copyright 2005 Sun Microsystems, Inc.  All rights reserved.
 * Use is subject to license terms.
 */

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <stdarg.h>
#include <unistd.h>
#include <errno.h>
#include <ctype.h>

#include <fcode/private.h>
#include <fcode/log.h>

#ifndef DEBUG_LVL
#define	DEBUG_LVL	0
#endif

struct bitab {
	token_t bi_ptr;
	char *bi_name;
	int bi_type;
};

struct bitab *lookup_builtin(token_t);

static int debug_level = DEBUG_LVL;

void
set_interpreter_debug_level(long lvl)
{
	debug_level = lvl;
}

long
get_interpreter_debug_level(void)
{
	return (debug_level);
}

void
output_data_stack(fcode_env_t *env, int msglevel)
{
	int i;

	log_message(msglevel, "( ");
	if (DS > env->ds0) {
		for (i = 0; i < (DS - env->ds0); i++)
			log_message(msglevel, "%llx ",
			    (uint64_t)(env->ds0[i + 1]));
	} else
		log_message(msglevel, "<empty> ");
	log_message(msglevel, ") ");
}

void
output_return_stack(fcode_env_t *env, int show_wa, int msglevel)
{
	int i;
	int anyout = 0;

	log_message(msglevel, "R:( ");
	if (show_wa) {
		log_message(msglevel, "%s ",
		    acf_backup_search(env, (acf_t)WA));
		anyout++;
	}
	if (IP) {
		anyout++;
		log_message(msglevel, "%s ", acf_backup_search(env, IP));
	}
	for (i = (RS - env->rs0) - 1; i > 0; i--) {
		anyout++;
		log_message(msglevel, "%s ",
		    acf_backup_search(env, (acf_t)env->rs0[i+1]));
	}
	if (!anyout)
		log_message(msglevel, "<empty> ");
	log_message(msglevel, ") ");
}

void
dump_comma(fcode_env_t *env, char *type)
{
	xforth_t d;

	if (strcmp(type, "x,") == 0)
		d = peek_xforth(env);
	else
		d = TOS;
	log_message(MSG_FC_DEBUG, "%s %p, %llx\n", type, HERE, (uint64_t)d);
}

static int ndebug_names;
#define	MAXDEBUG_NAMES	10
static char *debug_names[MAXDEBUG_NAMES];

static int ndebug_acfs;
#define	MAXDEBUG_ACFS	10
static acf_t debug_acfs[MAXDEBUG_ACFS];

void
add_debug_acf(fcode_env_t *env, acf_t acf)
{
	int i;

	for (i = 0; i < ndebug_acfs; i++)
		if (acf == debug_acfs[i])
			return;

	if (!within_dictionary(env, acf))
		log_message(MSG_ERROR, "Can't debug builtin\n");
	else if (ndebug_acfs >= MAXDEBUG_ACFS)
		log_message(MSG_ERROR, "Too many debug ACF's\n");
	else {
		debug_acfs[ndebug_acfs++] = acf;
		*LINK_TO_FLAGS(ACF_TO_LINK(acf)) |= FLAG_DEBUG;
	}
}

static void
paren_debug(fcode_env_t *env)
{
	acf_t acf;

	acf = (acf_t)POP(DS);
	if (!within_dictionary(env, acf)) {
		log_message(MSG_INFO, "acf: %llx not in dictionary\n",
		    (uint64_t)acf);
		return;
	}
	if ((acf_t)_ALIGN(acf, token_t) != acf) {
		log_message(MSG_INFO, "acf: %llx not aligned\n",
		    (uint64_t)acf);
		return;
	}
	if (*acf != (token_t)(&do_colon)) {
		log_message(MSG_INFO, "acf: %llx not a colon-def\n",
		    (uint64_t)acf);
		return;
	}
	add_debug_acf(env, acf);
}

static void
debug(fcode_env_t *env)
{
	fstack_t d;
	char *word;
	acf_t acf;

	parse_word(env);
	dollar_find(env);
	d = POP(DS);
	if (d) {
		acf = (acf_t)POP(DS);
		add_debug_acf(env, acf);
	} else if (ndebug_names >= MAXDEBUG_NAMES) {
		log_message(MSG_ERROR, "Too many forward debug words\n");
		two_drop(env);
	} else {
		word = pop_a_duped_string(env, NULL);
		log_message(MSG_INFO, "Forward defined word: %s\n", word);
		debug_names[ndebug_names++] = word;
	}
}

/*
 * Eliminate dups and add vocabulary forth to end if not already on list.
 */
static void
order_to_dict_list(fcode_env_t *env, token_t *order[])
{
	int i, j, norder = 0;

	if (env->current)
		order[norder++] = env->current;
	for (i = env->order_depth; i >= 0; i--) {
		for (j = 0; j < norder && order[j] != env->order[i]; j++)
			;
		if (j == norder)
			order[norder++] = env->order[i];
	}
	for (j = 0; j < norder && order[j] != (token_t *)&env->forth_voc_link;
	    j++)
		;
	if (j == norder)
		order[norder++] = (token_t *)&env->forth_voc_link;
	order[norder] = NULL;
}

static acf_t
search_all_dictionaries(fcode_env_t *env,
    acf_t (*fn)(fcode_env_t *, acf_t, void *),
    void *arg)
{
	token_t *order[MAX_ORDER+1];
	int i;
	token_t *dptr;
	acf_t acf;

	order_to_dict_list(env, order);
	for (i = 0; (dptr = order[i]) != NULL; i++) {
		for (dptr = (token_t *)(*dptr); dptr;
		    dptr = (token_t *)(*dptr))
			if ((acf = (*fn)(env, LINK_TO_ACF(dptr), arg)) != NULL)
				return (acf);
	}
	return (NULL);
}

char *
acf_to_str(acf_t acf)
{
	static char msg[(sizeof (acf) * 2) + 3];

	(void) sprintf(msg, "(%08p)", acf);
	return (msg);
}

char *
get_name_or_acf(token_t *dptr)
{
	char *name;

	if ((name = get_name(dptr)) != NULL)
		return (name);
	return (acf_to_str(LINK_TO_ACF(dptr)));
}

static void
output_acf_name(acf_t acf)
{
	char *name;
	token_t *dptr;
	static int acf_count = 0;

	if (acf == NULL) {
		if (acf_count)
			log_message(MSG_INFO, "\n");
		acf_count = 0;
		return;
	}
	dptr = ACF_TO_LINK(acf);
	if ((name = get_name(dptr)) == NULL)
		name = "<noname>";

	log_message(MSG_INFO, "%24s (%08p)", name, acf);
	if (++acf_count >= 2) {
		log_message(MSG_INFO, "\n");
		acf_count = 0;
	} else
		log_message(MSG_INFO, "    ");
}

static void
dot_debug(fcode_env_t *env)
{
	int i;
	token_t *dptr;

	if (ndebug_names == 0)
		log_message(MSG_INFO, "No forward debug words\n");
	else {
		for (i = 0; i < ndebug_names; i++)
			log_message(MSG_INFO, "%s Forward\n", debug_names[i]);
	}
	if (ndebug_acfs == 0)
		log_message(MSG_INFO, "No debug words\n");
	else {
		for (i = 0; i < ndebug_acfs; i++)
			log_message(MSG_INFO, "%s\n",
			    get_name_or_acf(ACF_TO_LINK(debug_acfs[i])));
	}
}

static void
do_undebug(fcode_env_t *env, char *name)
{
	int i;

	for (i = 0; i < ndebug_names; i++) {
		if (strcmp(debug_names[i], name) == 0) {
			log_message(MSG_INFO, "Undebugging forward word %s\n",
			    name);
			FREE(debug_names[i]);
			for (i++; i < ndebug_names; i++)
				debug_names[i - 1] = debug_names[i];
			ndebug_names--;
			break;
		}
	}
}

static void
undebug(fcode_env_t *env)
{
	fstack_t d;
	acf_t acf;
	flag_t *flagp;
	char *name;
	int i, j;

	parse_word(env);
	two_dup(env);
	dollar_find(env);
	d = POP(DS);
	if (d) {
		acf = (acf_t)POP(DS);
		flagp = LINK_TO_FLAGS(ACF_TO_LINK(acf));
		if ((*flagp & FLAG_DEBUG) == 0)
			log_message(MSG_WARN, "Word not debugged?\n");
		else {
			log_message(MSG_INFO, "Undebugging acf: %p\n", acf);
			*flagp &= ~FLAG_DEBUG;
			for (i = 0; i < ndebug_acfs; i++) {
				if (debug_acfs[i] == acf) {
					for (j = i + 1; j < ndebug_acfs; j++)
						debug_acfs[j-1] = debug_acfs[j];
					ndebug_acfs--;
					break;
				}
			}
		}
	} else
		two_drop(env);
	name = pop_a_string(env, NULL);
	do_undebug(env, name);
}

int
name_is_debugged(fcode_env_t *env, char *name)
{
	int i;

	if (ndebug_names <= 0)
		return (0);
	for (i = 0; i < ndebug_names; i++)
		if (strcmp(debug_names[i], name) == 0)
			return (1);
	return (0);
}

/*
 * This is complicated by being given ACF's to temporary compile words which
 * don't have a header.
 */
int
is_debug_word(fcode_env_t *env, acf_t acf)
{
	flag_t *flagp;
	int i;

	/* check to see if any words are being debugged */
	if (ndebug_acfs == 0)
		return (0);

	/* only words in dictionary can be debugged */
	if (!within_dictionary(env, acf))
		return (0);

	/* check that word has "FLAG_DEBUG" on */
	flagp = LINK_TO_FLAGS(ACF_TO_LINK(acf));
	if ((*flagp & FLAG_DEBUG) == 0)
		return (0);

	/* look in table of debug acf's */
	for (i = 0; i < ndebug_acfs; i++)
		if (debug_acfs[i] == acf)
			return (1);
	return (0);
}

#define	MAX_DEBUG_STACK	100
token_t debug_low[MAX_DEBUG_STACK], debug_high[MAX_DEBUG_STACK];
int debug_prev_level[MAX_DEBUG_STACK];
int debug_curr_level[MAX_DEBUG_STACK];
int ndebug_stack = 0;

void
debug_set_level(fcode_env_t *env, int level)
{
	debug_curr_level[ndebug_stack - 1] = level;
	set_interpreter_debug_level(level);
}

token_t
find_semi_in_colon_def(fcode_env_t *env, acf_t acf)
{
	for (; within_dictionary(env, acf); acf++)
		if (*acf == (token_t)(&semi_ptr))
			return ((token_t)acf);
	return (0);
}

void
check_for_debug_entry(fcode_env_t *env)
{
	int top;

	if (is_debug_word(env, WA) && ndebug_stack < MAX_DEBUG_STACK) {
		top = ndebug_stack++;
		debug_prev_level[top] = get_interpreter_debug_level();
		debug_low[top] = (token_t)WA;
		if (*WA == (token_t)(&do_colon)) {
			debug_high[top] =
			    find_semi_in_colon_def(env, WA);
		} else {
			debug_high[top] = 0;	/* marker... */
		}
		debug_set_level(env, DEBUG_STEPPING);
		output_step_message(env);
	}
}

void
check_for_debug_exit(fcode_env_t *env)
{
	if (ndebug_stack) {
		int top = ndebug_stack - 1;

		if (debug_high[top] == 0) {
			set_interpreter_debug_level(debug_prev_level[top]);
			ndebug_stack--;
		} else if ((token_t)IP >= debug_low[top] &&
		    (token_t)IP <= debug_high[top]) {
			set_interpreter_debug_level(debug_curr_level[top]);
		} else {
			set_interpreter_debug_level(debug_prev_level[top]);
		}
	}
}

void
check_semi_debug_exit(fcode_env_t *env)
{
	if (ndebug_stack) {
		int top = ndebug_stack - 1;

		if ((token_t)(IP - 1) == debug_high[top]) {
			set_interpreter_debug_level(debug_prev_level[top]);
			ndebug_stack--;
		}
	}
}

/*
 * Really entering do_run, since this may be a recursive entry to do_run,
 * we need to set the debug level to what it was previously.
 */
int
current_debug_state(fcode_env_t *env)
{
	if (ndebug_stack) {
		int top = ndebug_stack - 1;
		set_interpreter_debug_level(debug_prev_level[top]);
	}
	return (ndebug_stack);
}

void
clear_debug_state(fcode_env_t *env, int oldstate)
{
	if (ndebug_stack && oldstate <= ndebug_stack) {
		set_interpreter_debug_level(debug_prev_level[oldstate]);
		ndebug_stack = oldstate;
	}
}

void
unbug(fcode_env_t *env)
{
	int i;
	token_t *link;
	flag_t *flag;

	for (i = ndebug_stack - 1; i >= 0; i--) {
		link = ACF_TO_LINK(debug_low[i]);
		flag = LINK_TO_FLAGS(link);
		*flag &= ~FLAG_DEBUG;
	}
	clear_debug_state(env, 0);
}

void
output_vitals(fcode_env_t *env)
{
	log_message(MSG_FC_DEBUG, "IP=%p, *IP=%p, WA=%p, *WA=%p ", IP,
	    (IP ? *IP : 0), WA, (WA ? *WA : 0));
}

int
do_exec_debug(fcode_env_t *env, void *fn)
{
	int dl = debug_level;
	int show_wa = 1;

	if ((dl & (DEBUG_EXEC_DUMP_DS | DEBUG_EXEC_DUMP_RS |
	    DEBUG_EXEC_SHOW_VITALS | DEBUG_EXEC_TRACE | DEBUG_TRACING |
	    DEBUG_STEPPING)) == 0)
		return (0);

	if (dl & DEBUG_STEPPING) {
		dl |= DEBUG_EXEC_DUMP_DS;
	}
	if (dl & (DEBUG_STEPPING | DEBUG_EXEC_TRACE)) {
		log_message(MSG_FC_DEBUG, "%-15s ", acf_to_name(env, WA));
		show_wa = 0;
	}
	if (dl & DEBUG_EXEC_DUMP_DS)
		output_data_stack(env, MSG_FC_DEBUG);
	if (dl & DEBUG_EXEC_DUMP_RS)
		output_return_stack(env, show_wa, MSG_FC_DEBUG);
	if (dl & DEBUG_EXEC_SHOW_VITALS)
		output_vitals(env);
	if (dl & DEBUG_TRACING)
		do_fclib_trace(env, (void *) fn);
	log_message(MSG_FC_DEBUG, "\n");
	if (dl & DEBUG_STEPPING)
		return (do_fclib_step(env));
	return (0);
}

static void
smatch(fcode_env_t *env)
{
	int len;
	char *str, *p;

	if ((str = parse_a_string(env, &len)) == NULL)
		log_message(MSG_INFO, "smatch: no string\n");
	else {
		for (p = (char *)env->base; p < (char *)HERE; p++)
			if (memcmp(p, str, len) == 0)
				log_message(MSG_DEBUG, "%p\n", p);
	}
}

void
check_vitals(fcode_env_t *env)
{
	int i;
	token_t *dptr;

	dptr = env->current;
	if (*dptr && !within_dictionary(env, (uchar_t *)*dptr))
		log_message(MSG_ERROR, "Current: %p outside dictionary\n",
		    *dptr);
	for (i = env->order_depth; i >= 0; i--) {
		dptr = env->order[i];
		if (!dptr)
			continue;
		if (*dptr && !within_dictionary(env, (uchar_t *)*dptr))
			log_message(MSG_ERROR, "Order%d: %p outside"
			    " dictionary\n", i, *dptr);
	}
	if (HERE < env->base || HERE >= env->base + dict_size) {
		log_message(MSG_ERROR, "HERE: %p outside range\n", HERE);
	}
	if (DS < env->ds0 || DS >= &env->ds0[stack_size]) {
		forth_abort(env, "DS: %p outside range\n", DS);
	}
	if (RS < env->rs0 || RS >= &env->rs0[stack_size]) {
		log_message(MSG_ERROR, "RS: %p outside range\n", RS);
		RS = env->rs0;
	}
	if (IP && !within_dictionary(env, IP))
		log_message(MSG_ERROR, "IP: %p outside dictionary\n", IP);
	if (!within_dictionary(env, (void *)env->forth_voc_link))
		log_message(MSG_ERROR, "forth_voc_link: %p outside"
		    " dictionary\n", env->forth_voc_link);
}

static void
dump_table(fcode_env_t *env)
{
	int i;

	for (i = 0; i < MAX_FCODE; i++) {
		if (*(env->table[i].apf) != (token_t)(&f_error)) {
			log_message(MSG_DEBUG, "Token: %4x %32s acf = %8p,"
			    " %8p\n", i, env->table[i].name, env->table[i].apf,
			    *(env->table[i].apf));
		}
	}
	log_message(MSG_DEBUG, "%d FCODES implemented\n", fcode_impl_count);
}

void
verify_usage(fcode_env_t *env)
{
	int i, untested = 0;

	for (i = 0; i < MAX_FCODE; i++) {
		int verify;

		verify = env->table[i].flags & (ANSI_WORD|P1275_WORD);
		if ((verify) &&
#ifdef DEBUG
		    (env->table[i].usage == 0) &&
#endif
		    (env->table[i].apf)) {
			log_message(MSG_DEBUG,
			    "Untested: %4x %32s acf = %8p, %8p\n", i,
			    env->table[i].name, env->table[i].apf,
			    *(env->table[i].apf));
			untested++;
		}
	}
	if (untested)
		log_message(MSG_DEBUG, "%d untested tokens\n", untested);
}

static void
debugf(fcode_env_t *env)
{
	PUSH(DS, (fstack_t)&debug_level);
}

static void
control(fcode_env_t *env)
{
	PUSH(DS, (fstack_t)&env->control);
}

struct bittab {
	int b_bitval;
	char *b_bitname;
} bittab[] = {
	DEBUG_CONTEXT,		"context",
	DEBUG_BYTELOAD_DS,	"byteload-ds",
	DEBUG_BYTELOAD_RS,	"byteload-rs",
	DEBUG_BYTELOAD_TOKENS,	"byteload-tokens",
	DEBUG_NEW_TOKEN,	"new-token",
	DEBUG_EXEC_TRACE,	"exec-trace",
	DEBUG_EXEC_SHOW_VITALS,	"exec-show-vitals",
	DEBUG_EXEC_DUMP_DS,	"exec-dump-ds",
	DEBUG_EXEC_DUMP_RS,	"exec-dump-rs",
	DEBUG_COMMA,		"comma",
	DEBUG_HEADER,		"header",
	DEBUG_EXIT_WORDS,	"exit-words",
	DEBUG_EXIT_DUMP,	"exit-dump",
	DEBUG_DUMP_TOKENS,	"dump-tokens",
	DEBUG_COLON,		"colon",
	DEBUG_NEXT_VITALS,	"next-vitals",
	DEBUG_VOC_FIND,		"voc-find",
	DEBUG_DUMP_DICT_TOKENS,	"dump-dict-tokens",
	DEBUG_TOKEN_USAGE,	"token-usage",
	DEBUG_DUMP_TOKEN_TABLE,	"dump-token-table",
	DEBUG_SHOW_STACK,	"show-stack",
	DEBUG_SHOW_RS,		"show-rs",
	DEBUG_TRACING,		"tracing",
	DEBUG_TRACE_STACK,	"trace-stack",
	DEBUG_CALL_METHOD,	"call-method",
	DEBUG_ACTIONS,		"actions",
	DEBUG_STEPPING,		"stepping",
	DEBUG_REG_ACCESS,	"reg-access",
	DEBUG_ADDR_ABUSE,	"addr-abuse",
	DEBUG_FIND_FCODE,	"find-fcode",
	DEBUG_UPLOAD,		"upload",
	0
};

void
debug_flags_to_output(fcode_env_t *env, int flags)
{
	int first = 1, i;

	for (i = 0; bittab[i].b_bitval != 0; i++)
		if (bittab[i].b_bitval & flags) {
			if (!first)
				log_message(MSG_INFO, ",");
			first = 0;
			log_message(MSG_INFO, bittab[i].b_bitname);
		}
	if (first)
		log_message(MSG_INFO, "<empty>");
	log_message(MSG_INFO, "\n");
}

static void
dot_debugf(fcode_env_t *env)
{
	debug_flags_to_output(env, debug_level);
}

static void
debugf_qmark(fcode_env_t *env)
{
	debug_flags_to_output(env, 0xffffffff);
}

int
debug_flags_to_mask(char *str)
{
	int flags = 0;
	char *p;
	int i;

	if (isdigit(*str)) {
		if (*str == '0') {
			str++;
			if (*str == 'x' || *str == 'X') {
				(void) sscanf(str + 1, "%x", &flags);
			} else
				(void) sscanf(str, "%o", &flags);
		} else
			(void) sscanf(str, "%d", &flags);
		return (flags);
	}
	if (strcmp(str, "clear") == 0)
		return (0);
	if (strcmp(str, "all") == 0)
		return (0xffffffff & ~DEBUG_STEPPING);
	if (*str) {
		do {
			if (p = strchr(str, ','))
				*p++ = '\0';
			for (i = 0; bittab[i].b_bitname != 0; i++)
				if (strcmp(str, bittab[i].b_bitname) == 0) {
					flags |= bittab[i].b_bitval;
					break;
			}
			if (bittab[i].b_bitname == 0)
				log_message(MSG_WARN,
				    "Unknown debug flag: '%s'\n", str);
			str = p;
		} while (p);
	}
	return (flags);
}

static void
set_debugf(fcode_env_t *env)
{
	char *str;

	str = parse_a_string(env, NULL);
	debug_level = debug_flags_to_mask(str);
}

static acf_t
show_a_word(fcode_env_t *env, acf_t acf, void *arg)
{
	static int nshow_words = 0;

	if (acf == NULL) {
		if (nshow_words > 0) {
			log_message(MSG_DEBUG, "\n");
			nshow_words = 0;
		}
		return (NULL);
	}
	log_message(MSG_DEBUG, "%15s  ", get_name_or_acf(ACF_TO_LINK(acf)));
	nshow_words++;
	if (nshow_words >= 4) {
		log_message(MSG_DEBUG, "\n");
		nshow_words = 0;
	}
	return (NULL);
}

void
words(fcode_env_t *env)
{
	(void) search_all_dictionaries(env, show_a_word, NULL);
	(void) show_a_word(env, NULL, NULL);
}

static acf_t
dump_a_word(fcode_env_t *env, acf_t acf, void *arg)
{
	output_acf_name(acf);
	return (NULL);
}

void
dump_words(fcode_env_t *env)
{
	(void) search_all_dictionaries(env, dump_a_word, NULL);
	output_acf_name(NULL);
}

static void
dump_line(uchar_t *ptr)
{
	uchar_t *byte;
	int i;

	log_message(MSG_INFO, "%p  ", ptr);
	for (i = 0, byte = ptr; i < 16; i++) {
		if (i == 8)
			log_message(MSG_INFO, " ");
		log_message(MSG_INFO, "%02.2x ", *byte++);
	}
	log_message(MSG_INFO, " ");
	for (i = 0, byte = ptr; i < 16; i++, byte++) {
		log_message(MSG_INFO, "%c",
		    ((*byte < 0x20) || (*byte > 0x7f)) ? '.' : *byte);
	}
	log_message(MSG_INFO, "\n");
}

void
dump_dictionary(fcode_env_t *env)
{
	uchar_t *ptr;

	log_message(MSG_INFO, "Dictionary dump: base: %p\n", env->base);
	for (ptr = (uchar_t *)(((long)(env->base)) & ~0xf); ptr < HERE;
	    ptr += 16)
		dump_line(ptr);
}

static char *
acf_to_fcode_name(fcode_env_t *env, acf_t acf)
{
	int i;

	for (i = 0; i < MAX_FCODE; i++)
		if (env->table[i].apf == acf)
			return (env->table[i].name);
	return (NULL);
}

static acf_t
acf_match(fcode_env_t *env, acf_t sacf, void *macf)
{
	if (sacf == (acf_t)macf)
		return (sacf);
	return (NULL);
}

/*
 * Given an ACF, return ptr to name or "unknown" string.
 */
char *
acf_to_name(fcode_env_t *env, acf_t acf)
{
	struct bitab *bip;
	static char name_buf[256];
	uchar_t *p, *np;
	int i, n;

	if (!within_dictionary(env, acf)) {
		if ((bip = lookup_builtin((token_t)acf)) != NULL)
			return (bip->bi_name);
		return (NULL);
	}
	return (get_name_or_acf(ACF_TO_LINK(acf)));
}

int
within_dictionary(fcode_env_t *env, void *addr)
{
	return ((uchar_t *)addr >= env->base &&
	    (uchar_t *)addr < env->base + dict_size);
}

static int
within_word(fcode_env_t *env, acf_t acf, acf_t wacf)
{
	if (acf == wacf || acf + 1 == wacf)
		return (1);
	if (*acf == (token_t)(&do_colon)) {
		do {
			if (acf == wacf)
				return (1);
		} while (*acf++ != (token_t)(&semi_ptr));
	}
	return (0);
}

/*
 * Given an ACF in the middle of a colon definition, search dictionary towards
 * beginning for "colon" acf.  If we find a "semi" acf first, we're not in
 * the middle of a colon-def (temporary execute?).
 */
char *
acf_backup_search(fcode_env_t *env, acf_t acf)
{
	acf_t nacf;
	char *name;

	if ((acf_t)_ALIGN(acf, token_t) == acf && within_dictionary(env, acf)) {
		for (nacf = acf; nacf >= (acf_t)env->base; nacf--)
			if (*nacf == (token_t)(&do_colon) ||
			    *nacf == (token_t)(&semi_ptr))
				break;
		if (nacf >= (acf_t)env->base && *nacf == (token_t)(&do_colon) &&
		    (name = get_name(ACF_TO_LINK(nacf))) != NULL)
			return (name);
	}
	return (acf_to_str(acf));
}

/*
 * Print out current process's C stack using /usr/proc/bin/pstack
 */
void
ctrace(fcode_env_t *env)
{
	char buf[256];
	FILE *fd;

	log_message(MSG_DEBUG, "Interpreter C Stack:\n");
	(void) sprintf(buf, "/usr/proc/bin/pstack %d", getpid());
	if ((fd = popen(buf, "r")) == NULL)
		log_perror(MSG_ERROR, "Can't run: %s", buf);
	else {
		while (fgets(buf, sizeof (buf), fd))
			log_message(MSG_DEBUG, buf);
		(void) fclose(fd);
	}
}

/*
 * Dump data, return stacks, try to unthread forth calling stack.
 */
void
ftrace(fcode_env_t *env)
{
	log_message(MSG_DEBUG, "Forth Interpreter Stacks:\n");
	output_data_stack(env, MSG_DEBUG);
	output_return_stack(env, 1, MSG_DEBUG);
	log_message(MSG_DEBUG, "\n");
}

int in_forth_abort;

/*
 * Handle fatal error, if interactive mode, return to ok prompt.
 */
void
forth_abort(fcode_env_t *env, char *fmt, ...)
{
	va_list ap;
	char msg[256];

	if (in_forth_abort) {
		log_message(MSG_FATAL, "ABORT: abort within forth_abort\n");
		abort();
	}
	in_forth_abort++;

	va_start(ap, fmt);
	(void) vsprintf(msg, fmt, ap);
	log_message(MSG_ERROR, "ABORT: %s\n", msg);

	if (env) {
		ctrace(env);
		ftrace(env);
	}

	return_to_interact(env);
	/*
	 * If not in interactive mode, return_to_interact just returns.
	 */
	exit(1);
}

/*
 * Handle fatal system call error
 */
void
forth_perror(fcode_env_t *env, char *fmt, ...)
{
	va_list ap;
	char msg[256];
	int save_errno = errno;	/* just in case... */

	va_start(ap, fmt);
	(void) vsprintf(msg, fmt, ap);

	forth_abort(env, "%s: %s", msg, strerror(save_errno));
}

static void
show_stack(fcode_env_t *env)
{
#ifdef DEBUG
	debug_level ^= DEBUG_SHOW_STACK;
#else
	/*EMPTY*/
#endif
}

static void
print_bytes_header(int width, int offset)
{
	int i;

	for (i = 0; i < width; i++)
		log_message(MSG_INFO, " ");
	log_message(MSG_INFO, "  ");
	for (i = 0; i < 16; i++) {
		if (i == 8)
			log_message(MSG_INFO, " ");
		if (i == offset)
			log_message(MSG_INFO, "\\/ ");
		else
			log_message(MSG_INFO, "%2x ", i);
	}
	log_message(MSG_INFO, " ");
	for (i = 0; i < 16; i++) {
		if (i == offset)
			log_message(MSG_INFO, "v");
		else
			log_message(MSG_INFO, "%x", i);
	}
	log_message(MSG_INFO, "\n");
}

static void
dump(fcode_env_t *env)
{
	uchar_t *data;
	int len, offset;
	char buf[20];

	len = POP(DS);
	data = (uchar_t *)POP(DS);
	offset = ((long)data) & 0xf;
	len += offset;
	data = (uchar_t *)((long)data & ~0xf);
	(void) sprintf(buf, "%p", data);
	print_bytes_header(strlen(buf), offset);
	for (len += offset; len > 0; len -= 16, data += 16)
		dump_line(data);
}

static acf_t
do_sifting(fcode_env_t *env, acf_t acf, void *pat)
{
	char *name;

	if ((name = get_name(ACF_TO_LINK(acf))) != NULL && strstr(name, pat))
		output_acf_name(acf);
	return (NULL);
}

static void
sifting(fcode_env_t *env)
{
	char *pat;

	if ((pat = parse_a_string(env, NULL)) != NULL) {
		(void) search_all_dictionaries(env, do_sifting, pat);
		output_acf_name(NULL);
	}
}

void
print_level(int level, int *doprint)
{
	int i;

	if (*doprint) {
		log_message(MSG_DEBUG, "\n    ");
		for (i = 0; i < level; i++)
			log_message(MSG_DEBUG, "    ");
		*doprint = 0;
	}
}

#define	BI_QUOTE	1
#define	BI_BLIT		2
#define	BI_BDO		3
#define	BI_QDO		4
#define	BI_BR		5
#define	BI_QBR		6
#define	BI_BOF		7
#define	BI_LOOP		8
#define	BI_PLOOP	9
#define	BI_TO		10
#define	BI_SEMI		11
#define	BI_COLON	12
#define	BI_NOOP		13
#define	BI_NOTYET	14	/* unimplented in "see" */

struct bitab bitab[] = {
	(token_t)(&quote_ptr),			"\"",		BI_QUOTE,
	(token_t)(&blit_ptr),			"blit",		BI_BLIT,
	(token_t)(&do_bdo_ptr),			"do",		BI_BDO,
	(token_t)(&do_bqdo_ptr),		"?do",		BI_QDO,
	(token_t)(&bbranch_ptrs[0]),		"br",		BI_BR,
	(token_t)(&bbranch_ptrs[1]),		"qbr",		BI_QBR,
	(token_t)(&bbranch_ptrs[2]),		"bof",		BI_BOF,
	(token_t)(&do_loop_ptr),		"loop",		BI_LOOP,
	(token_t)(&do_ploop_ptr),		"+loop",	BI_PLOOP,
	(token_t)(&to_ptr),			"to",		BI_NOOP,
	(token_t)(&semi_ptr),			";",		BI_SEMI,
	(token_t)(&do_colon),			":",		BI_COLON,
	(token_t)(&tlit_ptr),			"[']",		BI_NOOP,
	(token_t)(&do_leave_ptr),		"leave",	BI_NOTYET,
	(token_t)(&create_ptr),			"create",	BI_NOTYET,
	(token_t)(&does_ptr),			"does>",	BI_NOTYET,
	(token_t)(&value_defines[0][0]),	"a.@",		BI_NOTYET,
	(token_t)(&value_defines[0][1]),	"a.!",		BI_NOTYET,
	(token_t)(&value_defines[0][2]),	"a.nop",	BI_NOTYET,
	(token_t)(&value_defines[1][0]),	"a.i@",		BI_NOTYET,
	(token_t)(&value_defines[1][1]),	"a.i!",		BI_NOTYET,
	(token_t)(&value_defines[1][2]),	"a.iad",	BI_NOTYET,
	(token_t)(&value_defines[2][0]),	"a.defer",	BI_NOTYET,
	(token_t)(&value_defines[2][1]),	"a.@",		BI_NOTYET,
	(token_t)(&value_defines[2][2]),	"a.nop",	BI_NOTYET,
	(token_t)(&value_defines[3][0]),	"a.defexec",	BI_NOTYET,
	(token_t)(&value_defines[3][1]),	"a.iset",	BI_NOTYET,
	(token_t)(&value_defines[3][2]),	"a.iad",	BI_NOTYET,
	(token_t)(&value_defines[4][0]),	"a.binit",	BI_NOTYET,
	(token_t)(&value_defines[4][1]),	"a.2drop",	BI_NOTYET,
	(token_t)(&value_defines[4][2]),	"a.nop",	BI_NOTYET,
	(token_t)(&value_defines[5][0]),	"a.ibinit",	BI_NOTYET,