10Sstevel@tonic-gate /*
20Sstevel@tonic-gate * CDDL HEADER START
30Sstevel@tonic-gate *
40Sstevel@tonic-gate * The contents of this file are subject to the terms of the
50Sstevel@tonic-gate * Common Development and Distribution License, Version 1.0 only
60Sstevel@tonic-gate * (the "License"). You may not use this file except in compliance
70Sstevel@tonic-gate * with the License.
80Sstevel@tonic-gate *
90Sstevel@tonic-gate * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
100Sstevel@tonic-gate * or http://www.opensolaris.org/os/licensing.
110Sstevel@tonic-gate * See the License for the specific language governing permissions
120Sstevel@tonic-gate * and limitations under the License.
130Sstevel@tonic-gate *
140Sstevel@tonic-gate * When distributing Covered Code, include this CDDL HEADER in each
150Sstevel@tonic-gate * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
160Sstevel@tonic-gate * If applicable, add the following below this CDDL HEADER, with the
170Sstevel@tonic-gate * fields enclosed by brackets "[]" replaced with your own identifying
180Sstevel@tonic-gate * information: Portions Copyright [yyyy] [name of copyright owner]
190Sstevel@tonic-gate *
200Sstevel@tonic-gate * CDDL HEADER END
210Sstevel@tonic-gate */
220Sstevel@tonic-gate /*
23*796Smathue * Copyright 2005 Sun Microsystems, Inc. All rights reserved.
240Sstevel@tonic-gate * Use is subject to license terms.
250Sstevel@tonic-gate */
260Sstevel@tonic-gate
270Sstevel@tonic-gate #pragma ident "%Z%%M% %I% %E% SMI"
280Sstevel@tonic-gate
290Sstevel@tonic-gate #include <stdio.h>
300Sstevel@tonic-gate #include <string.h>
310Sstevel@tonic-gate #include <stdlib.h>
320Sstevel@tonic-gate #include <stdarg.h>
330Sstevel@tonic-gate #include <unistd.h>
340Sstevel@tonic-gate #include <errno.h>
350Sstevel@tonic-gate #include <ctype.h>
360Sstevel@tonic-gate
370Sstevel@tonic-gate #include <fcode/private.h>
380Sstevel@tonic-gate #include <fcode/log.h>
390Sstevel@tonic-gate
400Sstevel@tonic-gate #ifndef DEBUG_LVL
410Sstevel@tonic-gate #define DEBUG_LVL 0
420Sstevel@tonic-gate #endif
430Sstevel@tonic-gate
440Sstevel@tonic-gate struct bitab {
450Sstevel@tonic-gate token_t bi_ptr;
460Sstevel@tonic-gate char *bi_name;
470Sstevel@tonic-gate int bi_type;
480Sstevel@tonic-gate };
490Sstevel@tonic-gate
500Sstevel@tonic-gate struct bitab *lookup_builtin(token_t);
510Sstevel@tonic-gate
520Sstevel@tonic-gate static int debug_level = DEBUG_LVL;
530Sstevel@tonic-gate
540Sstevel@tonic-gate void
set_interpreter_debug_level(long lvl)550Sstevel@tonic-gate set_interpreter_debug_level(long lvl)
560Sstevel@tonic-gate {
570Sstevel@tonic-gate debug_level = lvl;
580Sstevel@tonic-gate }
590Sstevel@tonic-gate
600Sstevel@tonic-gate long
get_interpreter_debug_level(void)610Sstevel@tonic-gate get_interpreter_debug_level(void)
620Sstevel@tonic-gate {
630Sstevel@tonic-gate return (debug_level);
640Sstevel@tonic-gate }
650Sstevel@tonic-gate
660Sstevel@tonic-gate void
output_data_stack(fcode_env_t * env,int msglevel)670Sstevel@tonic-gate output_data_stack(fcode_env_t *env, int msglevel)
680Sstevel@tonic-gate {
690Sstevel@tonic-gate int i;
700Sstevel@tonic-gate
710Sstevel@tonic-gate log_message(msglevel, "( ");
720Sstevel@tonic-gate if (DS > env->ds0) {
730Sstevel@tonic-gate for (i = 0; i < (DS - env->ds0); i++)
740Sstevel@tonic-gate log_message(msglevel, "%llx ",
750Sstevel@tonic-gate (uint64_t)(env->ds0[i + 1]));
760Sstevel@tonic-gate } else
770Sstevel@tonic-gate log_message(msglevel, "<empty> ");
780Sstevel@tonic-gate log_message(msglevel, ") ");
790Sstevel@tonic-gate }
800Sstevel@tonic-gate
810Sstevel@tonic-gate void
output_return_stack(fcode_env_t * env,int show_wa,int msglevel)820Sstevel@tonic-gate output_return_stack(fcode_env_t *env, int show_wa, int msglevel)
830Sstevel@tonic-gate {
840Sstevel@tonic-gate int i;
850Sstevel@tonic-gate int anyout = 0;
860Sstevel@tonic-gate
870Sstevel@tonic-gate log_message(msglevel, "R:( ");
880Sstevel@tonic-gate if (show_wa) {
890Sstevel@tonic-gate log_message(msglevel, "%s ",
900Sstevel@tonic-gate acf_backup_search(env, (acf_t)WA));
910Sstevel@tonic-gate anyout++;
920Sstevel@tonic-gate }
930Sstevel@tonic-gate if (IP) {
940Sstevel@tonic-gate anyout++;
950Sstevel@tonic-gate log_message(msglevel, "%s ", acf_backup_search(env, IP));
960Sstevel@tonic-gate }
970Sstevel@tonic-gate for (i = (RS - env->rs0) - 1; i > 0; i--) {
980Sstevel@tonic-gate anyout++;
990Sstevel@tonic-gate log_message(msglevel, "%s ",
1000Sstevel@tonic-gate acf_backup_search(env, (acf_t)env->rs0[i+1]));
1010Sstevel@tonic-gate }
1020Sstevel@tonic-gate if (!anyout)
1030Sstevel@tonic-gate log_message(msglevel, "<empty> ");
1040Sstevel@tonic-gate log_message(msglevel, ") ");
1050Sstevel@tonic-gate }
1060Sstevel@tonic-gate
1070Sstevel@tonic-gate void
dump_comma(fcode_env_t * env,char * type)1080Sstevel@tonic-gate dump_comma(fcode_env_t *env, char *type)
1090Sstevel@tonic-gate {
1100Sstevel@tonic-gate xforth_t d;
1110Sstevel@tonic-gate
1120Sstevel@tonic-gate if (strcmp(type, "x,") == 0)
1130Sstevel@tonic-gate d = peek_xforth(env);
1140Sstevel@tonic-gate else
1150Sstevel@tonic-gate d = TOS;
1160Sstevel@tonic-gate log_message(MSG_FC_DEBUG, "%s %p, %llx\n", type, HERE, (uint64_t)d);
1170Sstevel@tonic-gate }
1180Sstevel@tonic-gate
1190Sstevel@tonic-gate static int ndebug_names;
1200Sstevel@tonic-gate #define MAXDEBUG_NAMES 10
1210Sstevel@tonic-gate static char *debug_names[MAXDEBUG_NAMES];
1220Sstevel@tonic-gate
1230Sstevel@tonic-gate static int ndebug_acfs;
1240Sstevel@tonic-gate #define MAXDEBUG_ACFS 10
1250Sstevel@tonic-gate static acf_t debug_acfs[MAXDEBUG_ACFS];
1260Sstevel@tonic-gate
1270Sstevel@tonic-gate void
add_debug_acf(fcode_env_t * env,acf_t acf)1280Sstevel@tonic-gate add_debug_acf(fcode_env_t *env, acf_t acf)
1290Sstevel@tonic-gate {
1300Sstevel@tonic-gate int i;
1310Sstevel@tonic-gate
1320Sstevel@tonic-gate for (i = 0; i < ndebug_acfs; i++)
1330Sstevel@tonic-gate if (acf == debug_acfs[i])
1340Sstevel@tonic-gate return;
1350Sstevel@tonic-gate
1360Sstevel@tonic-gate if (!within_dictionary(env, acf))
1370Sstevel@tonic-gate log_message(MSG_ERROR, "Can't debug builtin\n");
1380Sstevel@tonic-gate else if (ndebug_acfs >= MAXDEBUG_ACFS)
1390Sstevel@tonic-gate log_message(MSG_ERROR, "Too many debug ACF's\n");
1400Sstevel@tonic-gate else {
1410Sstevel@tonic-gate debug_acfs[ndebug_acfs++] = acf;
1420Sstevel@tonic-gate *LINK_TO_FLAGS(ACF_TO_LINK(acf)) |= FLAG_DEBUG;
1430Sstevel@tonic-gate }
1440Sstevel@tonic-gate }
1450Sstevel@tonic-gate
1460Sstevel@tonic-gate static void
paren_debug(fcode_env_t * env)1470Sstevel@tonic-gate paren_debug(fcode_env_t *env)
1480Sstevel@tonic-gate {
1490Sstevel@tonic-gate acf_t acf;
1500Sstevel@tonic-gate
1510Sstevel@tonic-gate acf = (acf_t)POP(DS);
1520Sstevel@tonic-gate if (!within_dictionary(env, acf)) {
1530Sstevel@tonic-gate log_message(MSG_INFO, "acf: %llx not in dictionary\n",
1540Sstevel@tonic-gate (uint64_t)acf);
1550Sstevel@tonic-gate return;
1560Sstevel@tonic-gate }
1570Sstevel@tonic-gate if ((acf_t)_ALIGN(acf, token_t) != acf) {
1580Sstevel@tonic-gate log_message(MSG_INFO, "acf: %llx not aligned\n",
1590Sstevel@tonic-gate (uint64_t)acf);
1600Sstevel@tonic-gate return;
1610Sstevel@tonic-gate }
1620Sstevel@tonic-gate if (*acf != (token_t)(&do_colon)) {
1630Sstevel@tonic-gate log_message(MSG_INFO, "acf: %llx not a colon-def\n",
1640Sstevel@tonic-gate (uint64_t)acf);
1650Sstevel@tonic-gate return;
1660Sstevel@tonic-gate }
1670Sstevel@tonic-gate add_debug_acf(env, acf);
1680Sstevel@tonic-gate }
1690Sstevel@tonic-gate
1700Sstevel@tonic-gate static void
debug(fcode_env_t * env)1710Sstevel@tonic-gate debug(fcode_env_t *env)
1720Sstevel@tonic-gate {
1730Sstevel@tonic-gate fstack_t d;
1740Sstevel@tonic-gate char *word;
1750Sstevel@tonic-gate acf_t acf;
1760Sstevel@tonic-gate
1770Sstevel@tonic-gate parse_word(env);
1780Sstevel@tonic-gate dollar_find(env);
1790Sstevel@tonic-gate d = POP(DS);
1800Sstevel@tonic-gate if (d) {
1810Sstevel@tonic-gate acf = (acf_t)POP(DS);
1820Sstevel@tonic-gate add_debug_acf(env, acf);
1830Sstevel@tonic-gate } else if (ndebug_names >= MAXDEBUG_NAMES) {
1840Sstevel@tonic-gate log_message(MSG_ERROR, "Too many forward debug words\n");
1850Sstevel@tonic-gate two_drop(env);
1860Sstevel@tonic-gate } else {
1870Sstevel@tonic-gate word = pop_a_duped_string(env, NULL);
1880Sstevel@tonic-gate log_message(MSG_INFO, "Forward defined word: %s\n", word);
1890Sstevel@tonic-gate debug_names[ndebug_names++] = word;
1900Sstevel@tonic-gate }
1910Sstevel@tonic-gate }
1920Sstevel@tonic-gate
1930Sstevel@tonic-gate /*
1940Sstevel@tonic-gate * Eliminate dups and add vocabulary forth to end if not already on list.
1950Sstevel@tonic-gate */
1960Sstevel@tonic-gate static void
order_to_dict_list(fcode_env_t * env,token_t * order[])1970Sstevel@tonic-gate order_to_dict_list(fcode_env_t *env, token_t *order[])
1980Sstevel@tonic-gate {
1990Sstevel@tonic-gate int i, j, norder = 0;
2000Sstevel@tonic-gate
2010Sstevel@tonic-gate if (env->current)
2020Sstevel@tonic-gate order[norder++] = env->current;
2030Sstevel@tonic-gate for (i = env->order_depth; i >= 0; i--) {
2040Sstevel@tonic-gate for (j = 0; j < norder && order[j] != env->order[i]; j++)
2050Sstevel@tonic-gate ;
2060Sstevel@tonic-gate if (j == norder)
2070Sstevel@tonic-gate order[norder++] = env->order[i];
2080Sstevel@tonic-gate }
2090Sstevel@tonic-gate for (j = 0; j < norder && order[j] != (token_t *)&env->forth_voc_link;
2100Sstevel@tonic-gate j++)
2110Sstevel@tonic-gate ;
2120Sstevel@tonic-gate if (j == norder)
2130Sstevel@tonic-gate order[norder++] = (token_t *)&env->forth_voc_link;
2140Sstevel@tonic-gate order[norder] = NULL;
2150Sstevel@tonic-gate }
2160Sstevel@tonic-gate
2170Sstevel@tonic-gate static acf_t
search_all_dictionaries(fcode_env_t * env,acf_t (* fn)(fcode_env_t *,acf_t,void *),void * arg)2180Sstevel@tonic-gate search_all_dictionaries(fcode_env_t *env,
2190Sstevel@tonic-gate acf_t (*fn)(fcode_env_t *, acf_t, void *),
2200Sstevel@tonic-gate void *arg)
2210Sstevel@tonic-gate {
2220Sstevel@tonic-gate token_t *order[MAX_ORDER+1];
2230Sstevel@tonic-gate int i;
2240Sstevel@tonic-gate token_t *dptr;
2250Sstevel@tonic-gate acf_t acf;
2260Sstevel@tonic-gate
2270Sstevel@tonic-gate order_to_dict_list(env, order);
2280Sstevel@tonic-gate for (i = 0; (dptr = order[i]) != NULL; i++) {
2290Sstevel@tonic-gate for (dptr = (token_t *)(*dptr); dptr;
2300Sstevel@tonic-gate dptr = (token_t *)(*dptr))
2310Sstevel@tonic-gate if ((acf = (*fn)(env, LINK_TO_ACF(dptr), arg)) != NULL)
2320Sstevel@tonic-gate return (acf);
2330Sstevel@tonic-gate }
2340Sstevel@tonic-gate return (NULL);
2350Sstevel@tonic-gate }
2360Sstevel@tonic-gate
2370Sstevel@tonic-gate char *
acf_to_str(acf_t acf)2380Sstevel@tonic-gate acf_to_str(acf_t acf)
2390Sstevel@tonic-gate {
2400Sstevel@tonic-gate static char msg[(sizeof (acf) * 2) + 3];
2410Sstevel@tonic-gate
2420Sstevel@tonic-gate sprintf(msg, "(%08p)", acf);
2430Sstevel@tonic-gate return (msg);
2440Sstevel@tonic-gate }
2450Sstevel@tonic-gate
2460Sstevel@tonic-gate char *
get_name_or_acf(token_t * dptr)2470Sstevel@tonic-gate get_name_or_acf(token_t *dptr)
2480Sstevel@tonic-gate {
2490Sstevel@tonic-gate char *name;
2500Sstevel@tonic-gate
2510Sstevel@tonic-gate if ((name = get_name(dptr)) != NULL)
2520Sstevel@tonic-gate return (name);
2530Sstevel@tonic-gate return (acf_to_str(LINK_TO_ACF(dptr)));
2540Sstevel@tonic-gate }
2550Sstevel@tonic-gate
2560Sstevel@tonic-gate static void
output_acf_name(acf_t acf)2570Sstevel@tonic-gate output_acf_name(acf_t acf)
2580Sstevel@tonic-gate {
2590Sstevel@tonic-gate char *name;
2600Sstevel@tonic-gate token_t *dptr;
2610Sstevel@tonic-gate static int acf_count = 0;
2620Sstevel@tonic-gate
2630Sstevel@tonic-gate if (acf == NULL) {
2640Sstevel@tonic-gate if (acf_count)
2650Sstevel@tonic-gate log_message(MSG_INFO, "\n");
2660Sstevel@tonic-gate acf_count = 0;
2670Sstevel@tonic-gate return;
2680Sstevel@tonic-gate }
2690Sstevel@tonic-gate dptr = ACF_TO_LINK(acf);
2700Sstevel@tonic-gate if ((name = get_name(dptr)) == NULL)
2710Sstevel@tonic-gate name = "<noname>";
2720Sstevel@tonic-gate
2730Sstevel@tonic-gate log_message(MSG_INFO, "%24s (%08p)", name, acf);
2740Sstevel@tonic-gate if (++acf_count >= 2) {
2750Sstevel@tonic-gate log_message(MSG_INFO, "\n");
2760Sstevel@tonic-gate acf_count = 0;
2770Sstevel@tonic-gate } else
2780Sstevel@tonic-gate log_message(MSG_INFO, " ");
2790Sstevel@tonic-gate }
2800Sstevel@tonic-gate
2810Sstevel@tonic-gate static void
dot_debug(fcode_env_t * env)2820Sstevel@tonic-gate dot_debug(fcode_env_t *env)
2830Sstevel@tonic-gate {
2840Sstevel@tonic-gate int i;
2850Sstevel@tonic-gate token_t *dptr;
2860Sstevel@tonic-gate
2870Sstevel@tonic-gate if (ndebug_names == 0)
2880Sstevel@tonic-gate log_message(MSG_INFO, "No forward debug words\n");
2890Sstevel@tonic-gate else {
2900Sstevel@tonic-gate for (i = 0; i < ndebug_names; i++)
2910Sstevel@tonic-gate log_message(MSG_INFO, "%s Forward\n", debug_names[i]);
2920Sstevel@tonic-gate }
2930Sstevel@tonic-gate if (ndebug_acfs == 0)
2940Sstevel@tonic-gate log_message(MSG_INFO, "No debug words\n");
2950Sstevel@tonic-gate else {
2960Sstevel@tonic-gate for (i = 0; i < ndebug_acfs; i++)
2970Sstevel@tonic-gate log_message(MSG_INFO, "%s\n",
2980Sstevel@tonic-gate get_name_or_acf(ACF_TO_LINK(debug_acfs[i])));
2990Sstevel@tonic-gate }
3000Sstevel@tonic-gate }
3010Sstevel@tonic-gate
3020Sstevel@tonic-gate static void
do_undebug(fcode_env_t * env,char * name)3030Sstevel@tonic-gate do_undebug(fcode_env_t *env, char *name)
3040Sstevel@tonic-gate {
3050Sstevel@tonic-gate int i;
3060Sstevel@tonic-gate
3070Sstevel@tonic-gate for (i = 0; i < ndebug_names; i++) {
3080Sstevel@tonic-gate if (strcmp(debug_names[i], name) == 0) {
3090Sstevel@tonic-gate log_message(MSG_INFO, "Undebugging forward word %s\n",
3100Sstevel@tonic-gate name);
3110Sstevel@tonic-gate FREE(debug_names[i]);
3120Sstevel@tonic-gate for (i++; i < ndebug_names; i++)
3130Sstevel@tonic-gate debug_names[i - 1] = debug_names[i];
3140Sstevel@tonic-gate ndebug_names--;
3150Sstevel@tonic-gate break;
3160Sstevel@tonic-gate }
3170Sstevel@tonic-gate }
3180Sstevel@tonic-gate }
3190Sstevel@tonic-gate
3200Sstevel@tonic-gate static void
undebug(fcode_env_t * env)3210Sstevel@tonic-gate undebug(fcode_env_t *env)
3220Sstevel@tonic-gate {
3230Sstevel@tonic-gate fstack_t d;
3240Sstevel@tonic-gate acf_t acf;
3250Sstevel@tonic-gate flag_t *flagp;
3260Sstevel@tonic-gate char *name;
3270Sstevel@tonic-gate int i, j;
3280Sstevel@tonic-gate
3290Sstevel@tonic-gate parse_word(env);
3300Sstevel@tonic-gate two_dup(env);
3310Sstevel@tonic-gate dollar_find(env);
3320Sstevel@tonic-gate d = POP(DS);
3330Sstevel@tonic-gate if (d) {
3340Sstevel@tonic-gate acf = (acf_t)POP(DS);
3350Sstevel@tonic-gate flagp = LINK_TO_FLAGS(ACF_TO_LINK(acf));
3360Sstevel@tonic-gate if ((*flagp & FLAG_DEBUG) == 0)
3370Sstevel@tonic-gate log_message(MSG_WARN, "Word not debugged?\n");
3380Sstevel@tonic-gate else {
3390Sstevel@tonic-gate log_message(MSG_INFO, "Undebugging acf: %p\n", acf);
3400Sstevel@tonic-gate *flagp &= ~FLAG_DEBUG;
3410Sstevel@tonic-gate for (i = 0; i < ndebug_acfs; i++) {
3420Sstevel@tonic-gate if (debug_acfs[i] == acf) {
3430Sstevel@tonic-gate for (j = i + 1; j < ndebug_acfs; j++)
3440Sstevel@tonic-gate debug_acfs[j-1] = debug_acfs[j];
3450Sstevel@tonic-gate ndebug_acfs--;
3460Sstevel@tonic-gate break;
3470Sstevel@tonic-gate }
3480Sstevel@tonic-gate }
3490Sstevel@tonic-gate }
3500Sstevel@tonic-gate } else
3510Sstevel@tonic-gate two_drop(env);
3520Sstevel@tonic-gate name = pop_a_string(env, NULL);
3530Sstevel@tonic-gate do_undebug(env, name);
3540Sstevel@tonic-gate }
3550Sstevel@tonic-gate
3560Sstevel@tonic-gate int
name_is_debugged(fcode_env_t * env,char * name)3570Sstevel@tonic-gate name_is_debugged(fcode_env_t *env, char *name)
3580Sstevel@tonic-gate {
3590Sstevel@tonic-gate int i;
3600Sstevel@tonic-gate
3610Sstevel@tonic-gate if (ndebug_names <= 0)
3620Sstevel@tonic-gate return (0);
3630Sstevel@tonic-gate for (i = 0; i < ndebug_names; i++)
3640Sstevel@tonic-gate if (strcmp(debug_names[i], name) == 0)
3650Sstevel@tonic-gate return (1);
3660Sstevel@tonic-gate return (0);
3670Sstevel@tonic-gate }
3680Sstevel@tonic-gate
3690Sstevel@tonic-gate /*
3700Sstevel@tonic-gate * This is complicated by being given ACF's to temporary compile words which
3710Sstevel@tonic-gate * don't have a header.
3720Sstevel@tonic-gate */
3730Sstevel@tonic-gate int
is_debug_word(fcode_env_t * env,acf_t acf)3740Sstevel@tonic-gate is_debug_word(fcode_env_t *env, acf_t acf)
3750Sstevel@tonic-gate {
3760Sstevel@tonic-gate flag_t *flagp;
3770Sstevel@tonic-gate int i;
3780Sstevel@tonic-gate
3790Sstevel@tonic-gate /* check to see if any words are being debugged */
3800Sstevel@tonic-gate if (ndebug_acfs == 0)
3810Sstevel@tonic-gate return (0);
3820Sstevel@tonic-gate
3830Sstevel@tonic-gate /* only words in dictionary can be debugged */
3840Sstevel@tonic-gate if (!within_dictionary(env, acf))
3850Sstevel@tonic-gate return (0);
3860Sstevel@tonic-gate
3870Sstevel@tonic-gate /* check that word has "FLAG_DEBUG" on */
3880Sstevel@tonic-gate flagp = LINK_TO_FLAGS(ACF_TO_LINK(acf));
3890Sstevel@tonic-gate if ((*flagp & FLAG_DEBUG) == 0)
3900Sstevel@tonic-gate return (0);
3910Sstevel@tonic-gate
3920Sstevel@tonic-gate /* look in table of debug acf's */
3930Sstevel@tonic-gate for (i = 0; i < ndebug_acfs; i++)
3940Sstevel@tonic-gate if (debug_acfs[i] == acf)
3950Sstevel@tonic-gate return (1);
3960Sstevel@tonic-gate return (0);
3970Sstevel@tonic-gate }
3980Sstevel@tonic-gate
3990Sstevel@tonic-gate #define MAX_DEBUG_STACK 100
4000Sstevel@tonic-gate token_t debug_low[MAX_DEBUG_STACK], debug_high[MAX_DEBUG_STACK];
4010Sstevel@tonic-gate int debug_prev_level[MAX_DEBUG_STACK];
4020Sstevel@tonic-gate int debug_curr_level[MAX_DEBUG_STACK];
4030Sstevel@tonic-gate int ndebug_stack = 0;
4040Sstevel@tonic-gate
4050Sstevel@tonic-gate void
debug_set_level(fcode_env_t * env,int level)4060Sstevel@tonic-gate debug_set_level(fcode_env_t *env, int level)
4070Sstevel@tonic-gate {
4080Sstevel@tonic-gate debug_curr_level[ndebug_stack - 1] = level;
4090Sstevel@tonic-gate set_interpreter_debug_level(level);
4100Sstevel@tonic-gate }
4110Sstevel@tonic-gate
4120Sstevel@tonic-gate token_t
find_semi_in_colon_def(fcode_env_t * env,acf_t acf)4130Sstevel@tonic-gate find_semi_in_colon_def(fcode_env_t *env, acf_t acf)
4140Sstevel@tonic-gate {
4150Sstevel@tonic-gate for (; within_dictionary(env, acf); acf++)
4160Sstevel@tonic-gate if (*acf == (token_t)(&semi_ptr))
4170Sstevel@tonic-gate return ((token_t)acf);
4180Sstevel@tonic-gate return (0);
4190Sstevel@tonic-gate }
4200Sstevel@tonic-gate
4210Sstevel@tonic-gate void
check_for_debug_entry(fcode_env_t * env)4220Sstevel@tonic-gate check_for_debug_entry(fcode_env_t *env)
4230Sstevel@tonic-gate {
4240Sstevel@tonic-gate int top;
4250Sstevel@tonic-gate
4260Sstevel@tonic-gate if (is_debug_word(env, WA) && ndebug_stack < MAX_DEBUG_STACK) {
4270Sstevel@tonic-gate top = ndebug_stack++;
4280Sstevel@tonic-gate debug_prev_level[top] = get_interpreter_debug_level();
4290Sstevel@tonic-gate debug_low[top] = (token_t)WA;
4300Sstevel@tonic-gate if (*WA == (token_t)(&do_colon)) {
4310Sstevel@tonic-gate debug_high[top] =
4320Sstevel@tonic-gate find_semi_in_colon_def(env, WA);
4330Sstevel@tonic-gate } else {
4340Sstevel@tonic-gate debug_high[top] = 0; /* marker... */
4350Sstevel@tonic-gate }
4360Sstevel@tonic-gate debug_set_level(env, DEBUG_STEPPING);
4370Sstevel@tonic-gate output_step_message(env);
4380Sstevel@tonic-gate }
4390Sstevel@tonic-gate }
4400Sstevel@tonic-gate
4410Sstevel@tonic-gate void
check_for_debug_exit(fcode_env_t * env)4420Sstevel@tonic-gate check_for_debug_exit(fcode_env_t *env)
4430Sstevel@tonic-gate {
4440Sstevel@tonic-gate if (ndebug_stack) {
4450Sstevel@tonic-gate int top = ndebug_stack - 1;
4460Sstevel@tonic-gate
4470Sstevel@tonic-gate if (debug_high[top] == 0) {
4480Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[top]);
4490Sstevel@tonic-gate ndebug_stack--;
4500Sstevel@tonic-gate } else if ((token_t)IP >= debug_low[top] &&
4510Sstevel@tonic-gate (token_t)IP <= debug_high[top]) {
4520Sstevel@tonic-gate set_interpreter_debug_level(debug_curr_level[top]);
4530Sstevel@tonic-gate } else {
4540Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[top]);
4550Sstevel@tonic-gate }
4560Sstevel@tonic-gate }
4570Sstevel@tonic-gate }
4580Sstevel@tonic-gate
4590Sstevel@tonic-gate void
check_semi_debug_exit(fcode_env_t * env)4600Sstevel@tonic-gate check_semi_debug_exit(fcode_env_t *env)
4610Sstevel@tonic-gate {
4620Sstevel@tonic-gate if (ndebug_stack) {
4630Sstevel@tonic-gate int top = ndebug_stack - 1;
4640Sstevel@tonic-gate
4650Sstevel@tonic-gate if ((token_t)(IP - 1) == debug_high[top]) {
4660Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[top]);
4670Sstevel@tonic-gate ndebug_stack--;
4680Sstevel@tonic-gate }
4690Sstevel@tonic-gate }
4700Sstevel@tonic-gate }
4710Sstevel@tonic-gate
4720Sstevel@tonic-gate /*
4730Sstevel@tonic-gate * Really entering do_run, since this may be a recursive entry to do_run,
4740Sstevel@tonic-gate * we need to set the debug level to what it was previously.
4750Sstevel@tonic-gate */
4760Sstevel@tonic-gate int
current_debug_state(fcode_env_t * env)4770Sstevel@tonic-gate current_debug_state(fcode_env_t *env)
4780Sstevel@tonic-gate {
4790Sstevel@tonic-gate if (ndebug_stack) {
4800Sstevel@tonic-gate int top = ndebug_stack - 1;
4810Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[top]);
4820Sstevel@tonic-gate }
4830Sstevel@tonic-gate return (ndebug_stack);
4840Sstevel@tonic-gate }
4850Sstevel@tonic-gate
4860Sstevel@tonic-gate void
clear_debug_state(fcode_env_t * env,int oldstate)4870Sstevel@tonic-gate clear_debug_state(fcode_env_t *env, int oldstate)
4880Sstevel@tonic-gate {
4890Sstevel@tonic-gate if (ndebug_stack && oldstate <= ndebug_stack) {
4900Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[oldstate]);
4910Sstevel@tonic-gate ndebug_stack = oldstate;
4920Sstevel@tonic-gate }
4930Sstevel@tonic-gate }
4940Sstevel@tonic-gate
4950Sstevel@tonic-gate void
unbug(fcode_env_t * env)4960Sstevel@tonic-gate unbug(fcode_env_t *env)
4970Sstevel@tonic-gate {
4980Sstevel@tonic-gate int i;
4990Sstevel@tonic-gate token_t *link;
5000Sstevel@tonic-gate flag_t *flag;
5010Sstevel@tonic-gate
5020Sstevel@tonic-gate for (i = ndebug_stack - 1; i >= 0; i--) {
5030Sstevel@tonic-gate link = ACF_TO_LINK(debug_low[i]);
5040Sstevel@tonic-gate flag = LINK_TO_FLAGS(link);
5050Sstevel@tonic-gate *flag &= ~FLAG_DEBUG;
5060Sstevel@tonic-gate }
5070Sstevel@tonic-gate clear_debug_state(env, 0);
5080Sstevel@tonic-gate }
5090Sstevel@tonic-gate
5100Sstevel@tonic-gate void
output_vitals(fcode_env_t * env)5110Sstevel@tonic-gate output_vitals(fcode_env_t *env)
5120Sstevel@tonic-gate {
5130Sstevel@tonic-gate log_message(MSG_FC_DEBUG, "IP=%p, *IP=%p, WA=%p, *WA=%p ", IP,
5140Sstevel@tonic-gate (IP ? *IP : 0), WA, (WA ? *WA : 0));
5150Sstevel@tonic-gate }
5160Sstevel@tonic-gate
5170Sstevel@tonic-gate int
do_exec_debug(fcode_env_t * env,void * fn)5180Sstevel@tonic-gate do_exec_debug(fcode_env_t *env, void *fn)
5190Sstevel@tonic-gate {
5200Sstevel@tonic-gate int dl = debug_level;
5210Sstevel@tonic-gate int show_wa = 1;
5220Sstevel@tonic-gate
5230Sstevel@tonic-gate if ((dl & (DEBUG_EXEC_DUMP_DS | DEBUG_EXEC_DUMP_RS |
5240Sstevel@tonic-gate DEBUG_EXEC_SHOW_VITALS | DEBUG_EXEC_TRACE | DEBUG_TRACING |
5250Sstevel@tonic-gate DEBUG_STEPPING)) == 0)
5260Sstevel@tonic-gate return (0);
5270Sstevel@tonic-gate
5280Sstevel@tonic-gate if (dl & DEBUG_STEPPING) {
5290Sstevel@tonic-gate dl |= DEBUG_EXEC_DUMP_DS;
5300Sstevel@tonic-gate }
5310Sstevel@tonic-gate if (dl & (DEBUG_STEPPING | DEBUG_EXEC_TRACE)) {
5320Sstevel@tonic-gate log_message(MSG_FC_DEBUG, "%-15s ", acf_to_name(env, WA));
5330Sstevel@tonic-gate show_wa = 0;
5340Sstevel@tonic-gate }
5350Sstevel@tonic-gate if (dl & DEBUG_EXEC_DUMP_DS)
5360Sstevel@tonic-gate output_data_stack(env, MSG_FC_DEBUG);
5370Sstevel@tonic-gate if (dl & DEBUG_EXEC_DUMP_RS)
5380Sstevel@tonic-gate output_return_stack(env, show_wa, MSG_FC_DEBUG);
5390Sstevel@tonic-gate if (dl & DEBUG_EXEC_SHOW_VITALS)
5400Sstevel@tonic-gate output_vitals(env);
5410Sstevel@tonic-gate if (dl & DEBUG_TRACING)
5420Sstevel@tonic-gate do_fclib_trace(env, (void *) fn);
5430Sstevel@tonic-gate log_message(MSG_FC_DEBUG, "\n");
5440Sstevel@tonic-gate if (dl & DEBUG_STEPPING)
5450Sstevel@tonic-gate return (do_fclib_step(env));
5460Sstevel@tonic-gate return (0);
5470Sstevel@tonic-gate }
5480Sstevel@tonic-gate
5490Sstevel@tonic-gate static void
smatch(fcode_env_t * env)5500Sstevel@tonic-gate smatch(fcode_env_t *env)
5510Sstevel@tonic-gate {
5520Sstevel@tonic-gate int len;
5530Sstevel@tonic-gate char *str, *p;
5540Sstevel@tonic-gate
5550Sstevel@tonic-gate if ((str = parse_a_string(env, &len)) == NULL)
5560Sstevel@tonic-gate log_message(MSG_INFO, "smatch: no string\n");
5570Sstevel@tonic-gate else {
5580Sstevel@tonic-gate for (p = (char *)env->base; p < (char *)HERE; p++)
5590Sstevel@tonic-gate if (memcmp(p, str, len) == 0)
5600Sstevel@tonic-gate log_message(MSG_DEBUG, "%p\n", p);
5610Sstevel@tonic-gate }
5620Sstevel@tonic-gate }
5630Sstevel@tonic-gate
5640Sstevel@tonic-gate void
check_vitals(fcode_env_t * env)5650Sstevel@tonic-gate check_vitals(fcode_env_t *env)
5660Sstevel@tonic-gate {
5670Sstevel@tonic-gate int i;
5680Sstevel@tonic-gate token_t *dptr;
5690Sstevel@tonic-gate
5700Sstevel@tonic-gate dptr = env->current;
5710Sstevel@tonic-gate if (*dptr && !within_dictionary(env, (uchar_t *)*dptr))
5720Sstevel@tonic-gate log_message(MSG_ERROR, "Current: %p outside dictionary\n",
5730Sstevel@tonic-gate *dptr);
5740Sstevel@tonic-gate for (i = env->order_depth; i >= 0; i--) {
5750Sstevel@tonic-gate dptr = env->order[i];
5760Sstevel@tonic-gate if (!dptr)
5770Sstevel@tonic-gate continue;
5780Sstevel@tonic-gate if (*dptr && !within_dictionary(env, (uchar_t *)*dptr))
5790Sstevel@tonic-gate log_message(MSG_ERROR, "Order%d: %p outside"
5800Sstevel@tonic-gate " dictionary\n", i, *dptr);
5810Sstevel@tonic-gate }
5820Sstevel@tonic-gate if (HERE < env->base || HERE >= env->base + dict_size) {
5830Sstevel@tonic-gate log_message(MSG_ERROR, "HERE: %p outside range\n", HERE);
5840Sstevel@tonic-gate }
5850Sstevel@tonic-gate if (DS < env->ds0 || DS >= &env->ds0[stack_size]) {
5860Sstevel@tonic-gate forth_abort(env, "DS: %p outside range\n", DS);
5870Sstevel@tonic-gate }
5880Sstevel@tonic-gate if (RS < env->rs0 || RS >= &env->rs0[stack_size]) {
5890Sstevel@tonic-gate log_message(MSG_ERROR, "RS: %p outside range\n", RS);
5900Sstevel@tonic-gate RS = env->rs0;
5910Sstevel@tonic-gate }
5920Sstevel@tonic-gate if (IP && !within_dictionary(env, IP))
5930Sstevel@tonic-gate log_message(MSG_ERROR, "IP: %p outside dictionary\n", IP);
5940Sstevel@tonic-gate if (!within_dictionary(env, (void *)env->forth_voc_link))
5950Sstevel@tonic-gate log_message(MSG_ERROR, "forth_voc_link: %p outside"
5960Sstevel@tonic-gate " dictionary\n", env->forth_voc_link);
5970Sstevel@tonic-gate }
5980Sstevel@tonic-gate
5990Sstevel@tonic-gate static void
dump_table(fcode_env_t * env)6000Sstevel@tonic-gate dump_table(fcode_env_t *env)
6010Sstevel@tonic-gate {
6020Sstevel@tonic-gate int i;
6030Sstevel@tonic-gate
6040Sstevel@tonic-gate for (i = 0; i < MAX_FCODE; i++) {
6050Sstevel@tonic-gate if (*(env->table[i].apf) != (token_t)(&f_error)) {
6060Sstevel@tonic-gate log_message(MSG_DEBUG, "Token: %4x %32s acf = %8p,"
6070Sstevel@tonic-gate " %8p\n", i, env->table[i].name, env->table[i].apf,
6080Sstevel@tonic-gate *(env->table[i].apf));
6090Sstevel@tonic-gate }
6100Sstevel@tonic-gate }
6110Sstevel@tonic-gate log_message(MSG_DEBUG, "%d FCODES implemented\n", fcode_impl_count);
6120Sstevel@tonic-gate }
6130Sstevel@tonic-gate
6140Sstevel@tonic-gate void
verify_usage(fcode_env_t * env)6150Sstevel@tonic-gate verify_usage(fcode_env_t *env)
6160Sstevel@tonic-gate {
6170Sstevel@tonic-gate int i, untested = 0;
6180Sstevel@tonic-gate
6190Sstevel@tonic-gate for (i = 0; i < MAX_FCODE; i++) {
6200Sstevel@tonic-gate int verify;
6210Sstevel@tonic-gate
6220Sstevel@tonic-gate verify = env->table[i].flags & (ANSI_WORD|P1275_WORD);
6230Sstevel@tonic-gate if ((verify) &&
6240Sstevel@tonic-gate #ifdef DEBUG
6250Sstevel@tonic-gate (env->table[i].usage == 0) &&
6260Sstevel@tonic-gate #endif
6270Sstevel@tonic-gate (env->table[i].apf)) {
6280Sstevel@tonic-gate log_message(MSG_DEBUG,
6290Sstevel@tonic-gate "Untested: %4x %32s acf = %8p, %8p\n", i,
6300Sstevel@tonic-gate env->table[i].name, env->table[i].apf,
6310Sstevel@tonic-gate *(env->table[i].apf));
6320Sstevel@tonic-gate untested++;
6330Sstevel@tonic-gate }
6340Sstevel@tonic-gate }
6350Sstevel@tonic-gate if (untested)
6360Sstevel@tonic-gate log_message(MSG_DEBUG, "%d untested tokens\n", untested);
6370Sstevel@tonic-gate }
6380Sstevel@tonic-gate
6390Sstevel@tonic-gate static void
debugf(fcode_env_t * env)6400Sstevel@tonic-gate debugf(fcode_env_t *env)
6410Sstevel@tonic-gate {
6420Sstevel@tonic-gate PUSH(DS, (fstack_t)&debug_level);
6430Sstevel@tonic-gate }
6440Sstevel@tonic-gate
6450Sstevel@tonic-gate static void
control(fcode_env_t * env)6460Sstevel@tonic-gate control(fcode_env_t *env)
6470Sstevel@tonic-gate {
6480Sstevel@tonic-gate PUSH(DS, (fstack_t)&env->control);
6490Sstevel@tonic-gate }
6500Sstevel@tonic-gate
6510Sstevel@tonic-gate struct bittab {
6520Sstevel@tonic-gate int b_bitval;
6530Sstevel@tonic-gate char *b_bitname;
6540Sstevel@tonic-gate } bittab[] = {
6550Sstevel@tonic-gate DEBUG_CONTEXT, "context",
6560Sstevel@tonic-gate DEBUG_BYTELOAD_DS, "byteload-ds",
6570Sstevel@tonic-gate DEBUG_BYTELOAD_RS, "byteload-rs",
6580Sstevel@tonic-gate DEBUG_BYTELOAD_TOKENS, "byteload-tokens",
6590Sstevel@tonic-gate DEBUG_NEW_TOKEN, "new-token",
6600Sstevel@tonic-gate DEBUG_EXEC_TRACE, "exec-trace",
6610Sstevel@tonic-gate DEBUG_EXEC_SHOW_VITALS, "exec-show-vitals",
6620Sstevel@tonic-gate DEBUG_EXEC_DUMP_DS, "exec-dump-ds",
6630Sstevel@tonic-gate DEBUG_EXEC_DUMP_RS, "exec-dump-rs",
6640Sstevel@tonic-gate DEBUG_COMMA, "comma",
6650Sstevel@tonic-gate DEBUG_HEADER, "header",
6660Sstevel@tonic-gate DEBUG_EXIT_WORDS, "exit-words",
6670Sstevel@tonic-gate DEBUG_EXIT_DUMP, "exit-dump",
6680Sstevel@tonic-gate DEBUG_DUMP_TOKENS, "dump-tokens",
6690Sstevel@tonic-gate DEBUG_COLON, "colon",
6700Sstevel@tonic-gate DEBUG_NEXT_VITALS, "next-vitals",
6710Sstevel@tonic-gate DEBUG_VOC_FIND, "voc-find",
6720Sstevel@tonic-gate DEBUG_DUMP_DICT_TOKENS, "dump-dict-tokens",
6730Sstevel@tonic-gate DEBUG_TOKEN_USAGE, "token-usage",
6740Sstevel@tonic-gate DEBUG_DUMP_TOKEN_TABLE, "dump-token-table",
6750Sstevel@tonic-gate DEBUG_SHOW_STACK, "show-stack",
6760Sstevel@tonic-gate DEBUG_SHOW_RS, "show-rs",
6770Sstevel@tonic-gate DEBUG_TRACING, "tracing",
6780Sstevel@tonic-gate DEBUG_TRACE_STACK, "trace-stack",
6790Sstevel@tonic-gate DEBUG_CALL_METHOD, "call-method",
6800Sstevel@tonic-gate DEBUG_ACTIONS, "actions",
6810Sstevel@tonic-gate DEBUG_STEPPING, "stepping",
6820Sstevel@tonic-gate DEBUG_REG_ACCESS, "reg-access",
6830Sstevel@tonic-gate DEBUG_ADDR_ABUSE, "addr-abuse",
6840Sstevel@tonic-gate DEBUG_FIND_FCODE, "find-fcode",
6850Sstevel@tonic-gate DEBUG_UPLOAD, "upload",
6860Sstevel@tonic-gate 0
6870Sstevel@tonic-gate };
6880Sstevel@tonic-gate
6890Sstevel@tonic-gate void
debug_flags_to_output(fcode_env_t * env,int flags)6900Sstevel@tonic-gate debug_flags_to_output(fcode_env_t *env, int flags)
6910Sstevel@tonic-gate {
6920Sstevel@tonic-gate int first = 1, i;
6930Sstevel@tonic-gate
6940Sstevel@tonic-gate for (i = 0; bittab[i].b_bitval != 0; i++)
6950Sstevel@tonic-gate if (bittab[i].b_bitval & flags) {
6960Sstevel@tonic-gate if (!first)
6970Sstevel@tonic-gate log_message(MSG_INFO, ",");
6980Sstevel@tonic-gate first = 0;
6990Sstevel@tonic-gate log_message(MSG_INFO, bittab[i].b_bitname);
7000Sstevel@tonic-gate }
7010Sstevel@tonic-gate if (first)
7020Sstevel@tonic-gate log_message(MSG_INFO, "<empty>");
7030Sstevel@tonic-gate log_message(MSG_INFO, "\n");
7040Sstevel@tonic-gate }
7050Sstevel@tonic-gate
7060Sstevel@tonic-gate static void
dot_debugf(fcode_env_t * env)7070Sstevel@tonic-gate dot_debugf(fcode_env_t *env)
7080Sstevel@tonic-gate {
7090Sstevel@tonic-gate debug_flags_to_output(env, debug_level);
7100Sstevel@tonic-gate }
7110Sstevel@tonic-gate
7120Sstevel@tonic-gate static void
debugf_qmark(fcode_env_t * env)7130Sstevel@tonic-gate debugf_qmark(fcode_env_t *env)
7140Sstevel@tonic-gate {
7150Sstevel@tonic-gate debug_flags_to_output(env, 0xffffffff);
7160Sstevel@tonic-gate }
7170Sstevel@tonic-gate
7180Sstevel@tonic-gate int
debug_flags_to_mask(char * str)7190Sstevel@tonic-gate debug_flags_to_mask(char *str)
7200Sstevel@tonic-gate {
7210Sstevel@tonic-gate int flags = 0;
7220Sstevel@tonic-gate char *p;
7230Sstevel@tonic-gate int i;
7240Sstevel@tonic-gate
7250Sstevel@tonic-gate if (isdigit(*str)) {
7260Sstevel@tonic-gate if (*str == '0') {
7270Sstevel@tonic-gate str++;
7280Sstevel@tonic-gate if (*str == 'x' || *str == 'X') {
7290Sstevel@tonic-gate sscanf(str + 1, "%x", &flags);
7300Sstevel@tonic-gate } else
7310Sstevel@tonic-gate sscanf(str, "%o", &flags);
7320Sstevel@tonic-gate } else
7330Sstevel@tonic-gate sscanf(str, "%d", &flags);
7340Sstevel@tonic-gate return (flags);
7350Sstevel@tonic-gate }
7360Sstevel@tonic-gate if (strcmp(str, "clear") == 0)
7370Sstevel@tonic-gate return (0);
7380Sstevel@tonic-gate if (strcmp(str, "all") == 0)
7390Sstevel@tonic-gate return (0xffffffff & ~DEBUG_STEPPING);
7400Sstevel@tonic-gate if (*str) {
7410Sstevel@tonic-gate do {
7420Sstevel@tonic-gate if (p = strchr(str, ','))
7430Sstevel@tonic-gate *p++ = '\0';
7440Sstevel@tonic-gate for (i = 0; bittab[i].b_bitname != 0; i++)
7450Sstevel@tonic-gate if (strcmp(str, bittab[i].b_bitname) == 0) {
7460Sstevel@tonic-gate flags |= bittab[i].b_bitval;
7470Sstevel@tonic-gate break;
7480Sstevel@tonic-gate }
7490Sstevel@tonic-gate if (bittab[i].b_bitname == 0)
7500Sstevel@tonic-gate log_message(MSG_WARN,
7510Sstevel@tonic-gate "Unknown debug flag: '%s'\n", str);
7520Sstevel@tonic-gate str = p;
7530Sstevel@tonic-gate } while (p);
7540Sstevel@tonic-gate }
7550Sstevel@tonic-gate return (flags);
7560Sstevel@tonic-gate }
7570Sstevel@tonic-gate
7580Sstevel@tonic-gate static void
set_debugf(fcode_env_t * env)7590Sstevel@tonic-gate set_debugf(fcode_env_t *env)
7600Sstevel@tonic-gate {
7610Sstevel@tonic-gate char *str;
7620Sstevel@tonic-gate
7630Sstevel@tonic-gate str = parse_a_string(env, NULL);
7640Sstevel@tonic-gate debug_level = debug_flags_to_mask(str);
7650Sstevel@tonic-gate }
7660Sstevel@tonic-gate
7670Sstevel@tonic-gate static acf_t
show_a_word(fcode_env_t * env,acf_t acf,void * arg)7680Sstevel@tonic-gate show_a_word(fcode_env_t *env, acf_t acf, void *arg)
7690Sstevel@tonic-gate {
7700Sstevel@tonic-gate static int nshow_words = 0;
7710Sstevel@tonic-gate
7720Sstevel@tonic-gate if (acf == NULL) {
7730Sstevel@tonic-gate if (nshow_words > 0) {
7740Sstevel@tonic-gate log_message(MSG_DEBUG, "\n");
7750Sstevel@tonic-gate nshow_words = 0;
7760Sstevel@tonic-gate }
7770Sstevel@tonic-gate return (NULL);
7780Sstevel@tonic-gate }
7790Sstevel@tonic-gate log_message(MSG_DEBUG, "%15s ", get_name_or_acf(ACF_TO_LINK(acf)));
7800Sstevel@tonic-gate nshow_words++;
7810Sstevel@tonic-gate if (nshow_words >= 4) {
7820Sstevel@tonic-gate log_message(MSG_DEBUG, "\n");
7830Sstevel@tonic-gate nshow_words = 0;
7840Sstevel@tonic-gate }
7850Sstevel@tonic-gate return (NULL);
7860Sstevel@tonic-gate }
7870Sstevel@tonic-gate
7880Sstevel@tonic-gate void
words(fcode_env_t * env)7890Sstevel@tonic-gate words(fcode_env_t *env)
7900Sstevel@tonic-gate {
7910Sstevel@tonic-gate (void) search_all_dictionaries(env, show_a_word, NULL);
7920Sstevel@tonic-gate (void) show_a_word(env, NULL, NULL);
7930Sstevel@tonic-gate }
7940Sstevel@tonic-gate
7950Sstevel@tonic-gate static acf_t
dump_a_word(fcode_env_t * env,acf_t acf,void * arg)7960Sstevel@tonic-gate dump_a_word(fcode_env_t *env, acf_t acf, void *arg)
7970Sstevel@tonic-gate {
7980Sstevel@tonic-gate output_acf_name(acf);
7990Sstevel@tonic-gate return (NULL);
8000Sstevel@tonic-gate }
8010Sstevel@tonic-gate
8020Sstevel@tonic-gate void
dump_words(fcode_env_t * env)8030Sstevel@tonic-gate dump_words(fcode_env_t *env)
8040Sstevel@tonic-gate {
8050Sstevel@tonic-gate (void) search_all_dictionaries(env, dump_a_word, NULL);
8060Sstevel@tonic-gate output_acf_name(NULL);
8070Sstevel@tonic-gate }
8080Sstevel@tonic-gate
8090Sstevel@tonic-gate static void
dump_line(uchar_t * ptr)8100Sstevel@tonic-gate dump_line(uchar_t *ptr)
8110Sstevel@tonic-gate {
8120Sstevel@tonic-gate uchar_t *byte;
8130Sstevel@tonic-gate int i;
8140Sstevel@tonic-gate
815*796Smathue log_message(MSG_INFO, "%p ", ptr);
8160Sstevel@tonic-gate for (i = 0, byte = ptr; i < 16; i++) {
8170Sstevel@tonic-gate if (i == 8)
8180Sstevel@tonic-gate log_message(MSG_INFO, " ");
8190Sstevel@tonic-gate log_message(MSG_INFO, "%02.2x ", *byte++);
8200Sstevel@tonic-gate }
8210Sstevel@tonic-gate log_message(MSG_INFO, " ");
8220Sstevel@tonic-gate for (i = 0, byte = ptr; i < 16; i++, byte++) {
8230Sstevel@tonic-gate log_message(MSG_INFO, "%c",
8240Sstevel@tonic-gate ((*byte < 0x20) || (*byte > 0x7f)) ? '.' : *byte);
8250Sstevel@tonic-gate }
8260Sstevel@tonic-gate log_message(MSG_INFO, "\n");
8270Sstevel@tonic-gate }
8280Sstevel@tonic-gate
8290Sstevel@tonic-gate void
dump_dictionary(fcode_env_t * env)8300Sstevel@tonic-gate dump_dictionary(fcode_env_t *env)
8310Sstevel@tonic-gate {
8320Sstevel@tonic-gate uchar_t *ptr;
8330Sstevel@tonic-gate
8340Sstevel@tonic-gate log_message(MSG_INFO, "Dictionary dump: base: %p\n", env->base);
8350Sstevel@tonic-gate for (ptr = (uchar_t *)(((long)(env->base)) & ~0xf); ptr < HERE;
8360Sstevel@tonic-gate ptr += 16)
8370Sstevel@tonic-gate dump_line(ptr);
8380Sstevel@tonic-gate }
8390Sstevel@tonic-gate
8400Sstevel@tonic-gate static char *
acf_to_fcode_name(fcode_env_t * env,acf_t acf)8410Sstevel@tonic-gate acf_to_fcode_name(fcode_env_t *env, acf_t acf)
8420Sstevel@tonic-gate {
8430Sstevel@tonic-gate int i;
8440Sstevel@tonic-gate
8450Sstevel@tonic-gate for (i = 0; i < MAX_FCODE; i++)
8460Sstevel@tonic-gate if (env->table[i].apf == acf)
8470Sstevel@tonic-gate return (env->table[i].name);
8480Sstevel@tonic-gate return (NULL);
8490Sstevel@tonic-gate }
8500Sstevel@tonic-gate
8510Sstevel@tonic-gate static acf_t
acf_match(fcode_env_t * env,acf_t sacf,void * macf)8520Sstevel@tonic-gate acf_match(fcode_env_t *env, acf_t sacf, void *macf)
8530Sstevel@tonic-gate {
8540Sstevel@tonic-gate if (sacf == (acf_t)macf)
8550Sstevel@tonic-gate return (sacf);
8560Sstevel@tonic-gate return (NULL);
8570Sstevel@tonic-gate }
8580Sstevel@tonic-gate
8590Sstevel@tonic-gate /*
8600Sstevel@tonic-gate * Given an ACF, return ptr to name or "unknown" string.
8610Sstevel@tonic-gate */
8620Sstevel@tonic-gate char *
acf_to_name(fcode_env_t * env,acf_t acf)8630Sstevel@tonic-gate acf_to_name(fcode_env_t *env, acf_t acf)
8640Sstevel@tonic-gate {
8650Sstevel@tonic-gate struct bitab *bip;
8660Sstevel@tonic-gate static char name_buf[256];
8670Sstevel@tonic-gate uchar_t *p, *np;
8680Sstevel@tonic-gate int i, n;
8690Sstevel@tonic-gate
8700Sstevel@tonic-gate if (!within_dictionary(env, acf)) {
8710Sstevel@tonic-gate if ((bip = lookup_builtin((token_t)acf)) != NULL)
8720Sstevel@tonic-gate return (bip->bi_name);
8730Sstevel@tonic-gate return (NULL);
8740Sstevel@tonic-gate }
8750Sstevel@tonic-gate return (get_name_or_acf(ACF_TO_LINK(acf)));
8760Sstevel@tonic-gate }
8770Sstevel@tonic-gate
8780Sstevel@tonic-gate int
within_dictionary(fcode_env_t * env,void * addr)8790Sstevel@tonic-gate within_dictionary(fcode_env_t *env, void *addr)
8800Sstevel@tonic-gate {
8810Sstevel@tonic-gate return ((uchar_t *)addr >= env->base &&
8820Sstevel@tonic-gate (uchar_t *)addr < env->base + dict_size);
8830Sstevel@tonic-gate }
8840Sstevel@tonic-gate
8850Sstevel@tonic-gate static int
within_word(fcode_env_t * env,acf_t acf,acf_t wacf)8860Sstevel@tonic-gate within_word(fcode_env_t *env, acf_t acf, acf_t wacf)
8870Sstevel@tonic-gate {
8880Sstevel@tonic-gate if (acf == wacf || acf + 1 == wacf)
8890Sstevel@tonic-gate return (1);
8900Sstevel@tonic-gate if (*acf == (token_t)(&do_colon)) {
8910Sstevel@tonic-gate do {
8920Sstevel@tonic-gate if (acf == wacf)
8930Sstevel@tonic-gate return (1);
8940Sstevel@tonic-gate } while (*acf++ != (token_t)(&semi_ptr));
8950Sstevel@tonic-gate }
8960Sstevel@tonic-gate return (0);
8970Sstevel@tonic-gate }
8980Sstevel@tonic-gate
8990Sstevel@tonic-gate /*
9000Sstevel@tonic-gate * Given an ACF in the middle of a colon definition, search dictionary towards
9010Sstevel@tonic-gate * beginning for "colon" acf. If we find a "semi" acf first, we're not in
9020Sstevel@tonic-gate * the middle of a colon-def (temporary execute?).
9030Sstevel@tonic-gate */
9040Sstevel@tonic-gate char *
acf_backup_search(fcode_env_t * env,acf_t acf)9050Sstevel@tonic-gate acf_backup_search(fcode_env_t *env, acf_t acf)
9060Sstevel@tonic-gate {
9070Sstevel@tonic-gate acf_t nacf;
9080Sstevel@tonic-gate char *name;
9090Sstevel@tonic-gate
9100Sstevel@tonic-gate if ((acf_t)_ALIGN(acf, token_t) == acf && within_dictionary(env, acf)) {
9110Sstevel@tonic-gate for (nacf = acf; nacf >= (acf_t)env->base; nacf--)
9120Sstevel@tonic-gate if (*nacf == (token_t)(&do_colon) ||
9130Sstevel@tonic-gate *nacf == (token_t)(&semi_ptr))
9140Sstevel@tonic-gate break;
9150Sstevel@tonic-gate if (nacf >= (acf_t)env->base && *nacf == (token_t)(&do_colon) &&
9160Sstevel@tonic-gate (name = get_name(ACF_TO_LINK(nacf))) != NULL)
9170Sstevel@tonic-gate return (name);
9180Sstevel@tonic-gate }
9190Sstevel@tonic-gate return (acf_to_str(acf));
9200Sstevel@tonic-gate }
9210Sstevel@tonic-gate
9220Sstevel@tonic-gate /*
9230Sstevel@tonic-gate * Print out current process's C stack using /usr/proc/bin/pstack
9240Sstevel@tonic-gate */
9250Sstevel@tonic-gate void
ctrace(fcode_env_t * env)9260Sstevel@tonic-gate ctrace(fcode_env_t *env)
9270Sstevel@tonic-gate {
9280Sstevel@tonic-gate char buf[256];
9290Sstevel@tonic-gate FILE *fd;
9300Sstevel@tonic-gate
9310Sstevel@tonic-gate log_message(MSG_DEBUG, "Interpreter C Stack:\n");
9320Sstevel@tonic-gate sprintf(buf, "/usr/proc/bin/pstack %d", getpid());
9330Sstevel@tonic-gate if ((fd = popen(buf, "r")) == NULL)
9340Sstevel@tonic-gate log_perror(MSG_ERROR, "Can't run: %s", buf);
9350Sstevel@tonic-gate else {
9360Sstevel@tonic-gate while (fgets(buf, sizeof (buf), fd))
9370Sstevel@tonic-gate log_message(MSG_DEBUG, buf);
9380Sstevel@tonic-gate fclose(fd);
9390Sstevel@tonic-gate }
9400Sstevel@tonic-gate }
9410Sstevel@tonic-gate
9420Sstevel@tonic-gate /*
9430Sstevel@tonic-gate * Dump data, return stacks, try to unthread forth calling stack.
9440Sstevel@tonic-gate */
9450Sstevel@tonic-gate void
ftrace(fcode_env_t * env)9460Sstevel@tonic-gate ftrace(fcode_env_t *env)
9470Sstevel@tonic-gate {
9480Sstevel@tonic-gate log_message(MSG_DEBUG, "Forth Interpreter Stacks:\n");
9490Sstevel@tonic-gate output_data_stack(env, MSG_DEBUG);
9500Sstevel@tonic-gate output_return_stack(env, 1, MSG_DEBUG);
9510Sstevel@tonic-gate log_message(MSG_DEBUG, "\n");
9520Sstevel@tonic-gate }
9530Sstevel@tonic-gate
9540Sstevel@tonic-gate int in_forth_abort;
9550Sstevel@tonic-gate
9560Sstevel@tonic-gate /*
9570Sstevel@tonic-gate * Handle fatal error, if interactive mode, return to ok prompt.
9580Sstevel@tonic-gate */
9590Sstevel@tonic-gate void
forth_abort(fcode_env_t * env,char * fmt,...)9600Sstevel@tonic-gate forth_abort(fcode_env_t *env, char *fmt, ...)
9610Sstevel@tonic-gate {
9620Sstevel@tonic-gate va_list ap;
9630Sstevel@tonic-gate char msg[256];
9640Sstevel@tonic-gate
9650Sstevel@tonic-gate if (in_forth_abort) {
9660Sstevel@tonic-gate log_message(MSG_FATAL, "ABORT: abort within forth_abort\n");
9670Sstevel@tonic-gate abort();
9680Sstevel@tonic-gate }
9690Sstevel@tonic-gate in_forth_abort++;
9700Sstevel@tonic-gate
9710Sstevel@tonic-gate va_start(ap, fmt);
9720Sstevel@tonic-gate vsprintf(msg, fmt, ap);
9730Sstevel@tonic-gate log_message(MSG_ERROR, "ABORT: %s\n", msg);
9740Sstevel@tonic-gate
9750Sstevel@tonic-gate if (env) {
9760Sstevel@tonic-gate ctrace(env);
9770Sstevel@tonic-gate ftrace(env);
9780Sstevel@tonic-gate }
9790Sstevel@tonic-gate
9800Sstevel@tonic-gate return_to_interact(env);
9810Sstevel@tonic-gate /*
9820Sstevel@tonic-gate * If not in interactive mode, return_to_interact just returns.
9830Sstevel@tonic-gate */
9840Sstevel@tonic-gate exit(1);
9850Sstevel@tonic-gate }
9860Sstevel@tonic-gate
9870Sstevel@tonic-gate /*
9880Sstevel@tonic-gate * Handle fatal system call error
9890Sstevel@tonic-gate */
9900Sstevel@tonic-gate void
forth_perror(fcode_env_t * env,char * fmt,...)9910Sstevel@tonic-gate forth_perror(fcode_env_t *env, char *fmt, ...)
9920Sstevel@tonic-gate {
9930Sstevel@tonic-gate va_list ap;
9940Sstevel@tonic-gate char msg[256];
9950Sstevel@tonic-gate int save_errno = errno; /* just in case... */
9960Sstevel@tonic-gate
9970Sstevel@tonic-gate va_start(ap, fmt);
9980Sstevel@tonic-gate vsprintf(msg, fmt, ap);
9990Sstevel@tonic-gate
10000Sstevel@tonic-gate forth_abort(env, "%s: %s", msg, strerror(save_errno));
10010Sstevel@tonic-gate }
10020Sstevel@tonic-gate
10030Sstevel@tonic-gate static void
show_stack(fcode_env_t * env)10040Sstevel@tonic-gate show_stack(fcode_env_t *env)
10050Sstevel@tonic-gate {
10060Sstevel@tonic-gate #ifdef DEBUG
10070Sstevel@tonic-gate debug_level ^= DEBUG_SHOW_STACK;
10080Sstevel@tonic-gate #else
10090Sstevel@tonic-gate /*EMPTY*/
10100Sstevel@tonic-gate #endif
10110Sstevel@tonic-gate }
10120Sstevel@tonic-gate
10130Sstevel@tonic-gate static void
print_bytes_header(int width,int offset)10140Sstevel@tonic-gate print_bytes_header(int width, int offset)
10150Sstevel@tonic-gate {
10160Sstevel@tonic-gate int i;
10170Sstevel@tonic-gate
10180Sstevel@tonic-gate for (i = 0; i < width; i++)
10190Sstevel@tonic-gate log_message(MSG_INFO, " ");
10200Sstevel@tonic-gate log_message(MSG_INFO, " ");
10210Sstevel@tonic-gate for (i = 0; i < 16; i++) {
10220Sstevel@tonic-gate if (i == 8)
10230Sstevel@tonic-gate log_message(MSG_INFO, " ");
10240Sstevel@tonic-gate if (i == offset)
10250Sstevel@tonic-gate log_message(MSG_INFO, "\\/ ");
10260Sstevel@tonic-gate else
10270Sstevel@tonic-gate log_message(MSG_INFO, "%2x ", i);
10280Sstevel@tonic-gate }
10290Sstevel@tonic-gate log_message(MSG_INFO, " ");
10300Sstevel@tonic-gate for (i = 0; i < 16; i++) {
10310Sstevel@tonic-gate if (i == offset)
10320Sstevel@tonic-gate log_message(MSG_INFO, "v");
10330Sstevel@tonic-gate else
10340Sstevel@tonic-gate log_message(MSG_INFO, "%x", i);
10350Sstevel@tonic-gate }
10360Sstevel@tonic-gate log_message(MSG_INFO, "\n");
10370Sstevel@tonic-gate }
10380Sstevel@tonic-gate
10390Sstevel@tonic-gate static void
dump(fcode_env_t * env)10400Sstevel@tonic-gate dump(fcode_env_t *env)
10410Sstevel@tonic-gate {
10420Sstevel@tonic-gate uchar_t *data;
10430Sstevel@tonic-gate int len, offset;
10440Sstevel@tonic-gate char buf[20];
10450Sstevel@tonic-gate
10460Sstevel@tonic-gate len = POP(DS);
10470Sstevel@tonic-gate data = (uchar_t *)POP(DS);
10480Sstevel@tonic-gate offset = ((long)data) & 0xf;
10490Sstevel@tonic-gate len += offset;
10500Sstevel@tonic-gate data = (uchar_t *)((long)data & ~0xf);
1051*796Smathue sprintf(buf, "%p", data);
10520Sstevel@tonic-gate print_bytes_header(strlen(buf), offset);
10530Sstevel@tonic-gate for (len += offset; len > 0; len -= 16, data += 16)
10540Sstevel@tonic-gate dump_line(data);
10550Sstevel@tonic-gate }
10560Sstevel@tonic-gate
10570Sstevel@tonic-gate static acf_t
do_sifting(fcode_env_t * env,acf_t acf,void * pat)10580Sstevel@tonic-gate do_sifting(fcode_env_t *env, acf_t acf, void *pat)
10590Sstevel@tonic-gate {
10600Sstevel@tonic-gate char *name;
10610Sstevel@tonic-gate
10620Sstevel@tonic-gate if ((name = get_name(ACF_TO_LINK(acf))) != NULL && strstr(name, pat))
10630Sstevel@tonic-gate output_acf_name(acf);
10640Sstevel@tonic-gate return (NULL);
10650Sstevel@tonic-gate }
10660Sstevel@tonic-gate
10670Sstevel@tonic-gate static void
sifting(fcode_env_t * env)10680Sstevel@tonic-gate sifting(fcode_env_t *env)
10690Sstevel@tonic-gate {
10700Sstevel@tonic-gate char *pat;
10710Sstevel@tonic-gate
10720Sstevel@tonic-gate if ((pat = parse_a_string(env, NULL)) != NULL) {
10730Sstevel@tonic-gate (void) search_all_dictionaries(env, do_sifting, pat);
10740Sstevel@tonic-gate output_acf_name(NULL);
10750Sstevel@tonic-gate }
10760Sstevel@tonic-gate }
10770Sstevel@tonic-gate
10780Sstevel@tonic-gate void
print_level(int level,int * doprint)10790Sstevel@tonic-gate print_level(int level, int *doprint)
10800Sstevel@tonic-gate {
10810Sstevel@tonic-gate int i;
10820Sstevel@tonic-gate
10830Sstevel@tonic-gate if (*doprint) {
10840Sstevel@tonic-gate log_message(MSG_DEBUG, "\n ");
10850Sstevel@tonic-gate for (i = 0; i < level; i++)
10860Sstevel@tonic-gate log_message(MSG_DEBUG, " ");
10870Sstevel@tonic-gate *doprint = 0;
10880Sstevel@tonic-gate }
10890Sstevel@tonic-gate }
10900Sstevel@tonic-gate
10910Sstevel@tonic-gate #define BI_QUOTE 1
10920Sstevel@tonic-gate #define BI_BLIT 2
10930Sstevel@tonic-gate #define BI_BDO 3
10940Sstevel@tonic-gate #define BI_QDO 4
10950Sstevel@tonic-gate #define BI_BR 5
10960Sstevel@tonic-gate #define BI_QBR 6
10970Sstevel@tonic-gate #define BI_BOF 7
10980Sstevel@tonic-gate #define BI_LOOP 8
10990Sstevel@tonic-gate #define BI_PLOOP 9
11000Sstevel@tonic-gate #define BI_TO 10
11010Sstevel@tonic-gate #define BI_SEMI 11
11020Sstevel@tonic-gate #define BI_COLON 12
11030Sstevel@tonic-gate #define BI_NOOP 13
11040Sstevel@tonic-gate #define BI_NOTYET 14 /* unimplented in "see" */
11050Sstevel@tonic-gate
11060Sstevel@tonic-gate struct bitab bitab[] = {
11070Sstevel@tonic-gate (token_t)("e_ptr), "\"", BI_QUOTE,
11080Sstevel@tonic-gate (token_t)(&blit_ptr), "blit", BI_BLIT,
11090Sstevel@tonic-gate (token_t)(&do_bdo_ptr), "do", BI_BDO,
11100Sstevel@tonic-gate (token_t)(&do_bqdo_ptr), "?do", BI_QDO,
11110Sstevel@tonic-gate (token_t)(&bbranch_ptrs[0]), "br", BI_BR,
11120Sstevel@tonic-gate (token_t)(&bbranch_ptrs[1]), "qbr", BI_QBR,
11130Sstevel@tonic-gate (token_t)(&bbranch_ptrs[2]), "bof", BI_BOF,
11140Sstevel@tonic-gate (token_t)(&do_loop_ptr), "loop", BI_LOOP,
11150Sstevel@tonic-gate (token_t)(&do_ploop_ptr), "+loop", BI_PLOOP,
11160Sstevel@tonic-gate (token_t)(&to_ptr), "to", BI_NOOP,
11170Sstevel@tonic-gate (token_t)(&semi_ptr), ";", BI_SEMI,
11180Sstevel@tonic-gate (token_t)(&do_colon), ":", BI_COLON,
11190Sstevel@tonic-gate (token_t)(&tlit_ptr), "[']", BI_NOOP,
11200Sstevel@tonic-gate (token_t)(&do_leave_ptr), "leave", BI_NOTYET,
11210Sstevel@tonic-gate (token_t)(&create_ptr), "create", BI_NOTYET,
11220Sstevel@tonic-gate (token_t)(&does_ptr), "does>", BI_NOTYET,
11230Sstevel@tonic-gate (token_t)(&value_defines[0][0]), "a.@", BI_NOTYET,
11240Sstevel@tonic-gate (token_t)(&value_defines[0][1]), "a.!", BI_NOTYET,
11250Sstevel@tonic-gate (token_t)(&value_defines[0][2]), "a.nop", BI_NOTYET,
11260Sstevel@tonic-gate (token_t)(&value_defines[1][0]), "a.i@", BI_NOTYET,
11270Sstevel@tonic-gate (token_t)(&value_defines[1][1]), "a.i!", BI_NOTYET,
11280Sstevel@tonic-gate (token_t)(&value_defines[1][2]), "a.iad", BI_NOTYET,
11290Sstevel@tonic-gate (token_t)(&value_defines[2][0]), "a.defer", BI_NOTYET,
11300Sstevel@tonic-gate (token_t)(&value_defines[2][1]), "a.@", BI_NOTYET,
11310Sstevel@tonic-gate (token_t)(&value_defines[2][2]), "a.nop", BI_NOTYET,
11320Sstevel@tonic-gate (token_t)(&value_defines[3][0]), "a.defexec", BI_NOTYET,
11330Sstevel@tonic-gate (token_t)(&value_defines[3][1]), "a.iset", BI_NOTYET,
11340Sstevel@tonic-gate (token_t)(&value_defines[3][2]), "a.iad", BI_NOTYET,
11350Sstevel@tonic-gate (token_t)(&value_defines[4][0]), "a.binit", BI_NOTYET,
11360Sstevel@tonic-gate (token_t)(&value_defines[4][1]), "a.2drop", BI_NOTYET,
11370Sstevel@tonic-gate (token_t)(&value_defines[4][2]), "a.nop", BI_NOTYET,
11380Sstevel@tonic-gate (token_t)(&value_defines[5][0]), "a.ibinit", BI_NOTYET,
11390Sstevel@tonic-gate (token_t)(&value_defines[5][1]), "a.2drop", BI_NOTYET,
11400Sstevel@tonic-gate (token_t)(&value_defines[5][2]), "a.iad", BI_NOTYET,
11410Sstevel@tonic-gate 0
11420Sstevel@tonic-gate };
11430Sstevel@tonic-gate
11440Sstevel@tonic-gate struct bitab *
lookup_builtin(token_t builtin)11450Sstevel@tonic-gate lookup_builtin(token_t builtin)
11460Sstevel@tonic-gate {
11470Sstevel@tonic-gate int i;
11480Sstevel@tonic-gate
11490Sstevel@tonic-gate for (i = 0; bitab[i].bi_ptr; i++)
11500Sstevel@tonic-gate if (bitab[i].bi_ptr == builtin)
11510Sstevel@tonic-gate return (&bitab[i]);
11520Sstevel@tonic-gate return (NULL);
11530Sstevel@tonic-gate }
11540Sstevel@tonic-gate
11550Sstevel@tonic-gate static void
paren_see(fcode_env_t * env)11560Sstevel@tonic-gate paren_see(fcode_env_t *env)
11570Sstevel@tonic-gate {
11580Sstevel@tonic-gate acf_t save_acf = (acf_t)POP(DS);
11590Sstevel@tonic-gate acf_t acf = save_acf;
11600Sstevel@tonic-gate int i, n, pass;
11610Sstevel@tonic-gate token_t brtab[30], thentab[30], brstk[30];
11620Sstevel@tonic-gate int nbrtab = 0, nthentab = 0, nbrstk = 0;
11630Sstevel@tonic-gate uchar_t *p;
11640Sstevel@tonic-gate int level = 0, doprintlevel = 1, nthen;
11650Sstevel@tonic-gate struct bitab *bip;
11660Sstevel@tonic-gate token_t last_lit = 0, case_lit = 0, endof_loc = 0, endcase_loc = 0;
11670Sstevel@tonic-gate
11680Sstevel@tonic-gate if ((bip = lookup_builtin(*acf)) == NULL ||
11690Sstevel@tonic-gate bip->bi_type != BI_COLON) {
11700Sstevel@tonic-gate if (bip = lookup_builtin((token_t)acf))
11710Sstevel@tonic-gate log_message(MSG_INFO, "%s: builtin\n", bip->bi_name);
11720Sstevel@tonic-gate else
11730Sstevel@tonic-gate log_message(MSG_INFO, "%s: builtin\n",
11740Sstevel@tonic-gate acf_to_name(env, acf));
11750Sstevel@tonic-gate return;
11760Sstevel@tonic-gate }
11770Sstevel@tonic-gate log_message(MSG_INFO, ": %s", acf_to_name(env, acf));
11780Sstevel@tonic-gate for (pass = 0; pass < 2; pass++) {
11790Sstevel@tonic-gate acf = save_acf;
11800Sstevel@tonic-gate for (acf++; ; acf++) {
11810Sstevel@tonic-gate if (pass) {
11820Sstevel@tonic-gate print_level(level, &doprintlevel);
11830Sstevel@tonic-gate for (nthen = 0; nthentab > 0 &&
11840Sstevel@tonic-gate thentab[nthentab-1] == (token_t)acf;
11850Sstevel@tonic-gate nthentab--)
11860Sstevel@tonic-gate nthen++;
11870Sstevel@tonic-gate if (nthen) {
11880Sstevel@tonic-gate level -= nthen;
11890Sstevel@tonic-gate doprintlevel = 1;
11900Sstevel@tonic-gate print_level(level, &doprintlevel);
11910Sstevel@tonic-gate for (i = 0; i < nthen; i++)
11920Sstevel@tonic-gate log_message(MSG_INFO, "then ");
11930Sstevel@tonic-gate }
11940Sstevel@tonic-gate print_level(level, &doprintlevel);
11950Sstevel@tonic-gate for (i = 0; i < nbrtab; i += 2)
11960Sstevel@tonic-gate if ((token_t)acf == brtab[i]) {
11970Sstevel@tonic-gate log_message(MSG_INFO, "begin ");
11980Sstevel@tonic-gate brstk[nbrstk++] = brtab[i+1];
11990Sstevel@tonic-gate level++;
12000Sstevel@tonic-gate doprintlevel = 1;
12010Sstevel@tonic-gate }
12020Sstevel@tonic-gate print_level(level, &doprintlevel);
12030Sstevel@tonic-gate if (case_lit == (token_t)acf) {
12040Sstevel@tonic-gate log_message(MSG_INFO, "case ");
12050Sstevel@tonic-gate doprintlevel = 1;
12060Sstevel@tonic-gate print_level(level, &doprintlevel);
12070Sstevel@tonic-gate }
12080Sstevel@tonic-gate if (endof_loc == (token_t)acf) {
12090Sstevel@tonic-gate log_message(MSG_INFO, "endof ");
12100Sstevel@tonic-gate doprintlevel = 1;
12110Sstevel@tonic-gate print_level(level, &doprintlevel);
12120Sstevel@tonic-gate }
12130Sstevel@tonic-gate if (endcase_loc == (token_t)acf) {
12140Sstevel@tonic-gate doprintlevel = 1;
12150Sstevel@tonic-gate print_level(level, &doprintlevel);
12160Sstevel@tonic-gate log_message(MSG_INFO, "endcase ");
12170Sstevel@tonic-gate }
12180Sstevel@tonic-gate }
12190Sstevel@tonic-gate if ((bip = lookup_builtin((token_t)*acf)) == 0) {
12200Sstevel@tonic-gate last_lit = (token_t)acf;
12210Sstevel@tonic-gate if (pass)
12220Sstevel@tonic-gate log_message(MSG_INFO, "%s ",
12230Sstevel@tonic-gate acf_to_name(env, (acf_t)*acf));
12240Sstevel@tonic-gate continue;
12250Sstevel@tonic-gate }
12260Sstevel@tonic-gate if (bip->bi_type == BI_SEMI) {
12270Sstevel@tonic-gate if (pass) {
12280Sstevel@tonic-gate log_message(MSG_INFO, "\n");
12290Sstevel@tonic-gate log_message(MSG_INFO, "%s\n",
12300Sstevel@tonic-gate bip->bi_name);
12310Sstevel@tonic-gate }
12320Sstevel@tonic-gate break;
12330Sstevel@tonic-gate }
12340Sstevel@tonic-gate switch (bip->bi_type) {
12350Sstevel@tonic-gate
12360Sstevel@tonic-gate case BI_NOOP:
12370Sstevel@tonic-gate case BI_NOTYET:
12380Sstevel@tonic-gate if (pass)
12390Sstevel@tonic-gate log_message(MSG_INFO, "%s ",
12400Sstevel@tonic-gate bip->bi_name);
12410Sstevel@tonic-gate break;
12420Sstevel@tonic-gate
12430Sstevel@tonic-gate case BI_QUOTE:
12440Sstevel@tonic-gate if (pass)
12450Sstevel@tonic-gate log_message(MSG_INFO, "\" ");
12460Sstevel@tonic-gate acf++;
12470Sstevel@tonic-gate p = (uchar_t *)acf;
12480Sstevel@tonic-gate n = *p++;
12490Sstevel@tonic-gate if (pass)
12500Sstevel@tonic-gate log_message(MSG_INFO, "%s\" ", p);
12510Sstevel@tonic-gate p += n + 1;
12520Sstevel@tonic-gate for (; ((token_t)(p)) & (sizeof (token_t) - 1);
12530Sstevel@tonic-gate p++)
12540Sstevel@tonic-gate ;
12550Sstevel@tonic-gate acf = (acf_t)p;
12560Sstevel@tonic-gate acf--;
12570Sstevel@tonic-gate break;
12580Sstevel@tonic-gate
12590Sstevel@tonic-gate case BI_BLIT:
12600Sstevel@tonic-gate acf++;
12610Sstevel@tonic-gate if (pass)
12620Sstevel@tonic-gate log_message(MSG_INFO, "%x ", *acf);
12630Sstevel@tonic-gate break;
12640Sstevel@tonic-gate
12650Sstevel@tonic-gate case BI_BDO:
12660Sstevel@tonic-gate case BI_QDO:
12670Sstevel@tonic-gate if (pass) {
12680Sstevel@tonic-gate log_message(MSG_INFO, "%s ",
12690Sstevel@tonic-gate bip->bi_name);
12700Sstevel@tonic-gate doprintlevel = 1;
12710Sstevel@tonic-gate level++;
12720Sstevel@tonic-gate }
12730Sstevel@tonic-gate acf++;
12740Sstevel@tonic-gate break;
12750Sstevel@tonic-gate
12760Sstevel@tonic-gate case BI_BR:
12770Sstevel@tonic-gate acf++;
12780Sstevel@tonic-gate if (pass) {
12790Sstevel@tonic-gate if (*acf < (token_t)acf) {
12800Sstevel@tonic-gate if (nbrstk) {
12810Sstevel@tonic-gate doprintlevel = 1;
12820Sstevel@tonic-gate level--;
12830Sstevel@tonic-gate print_level(level,
12840Sstevel@tonic-gate &doprintlevel);
12850Sstevel@tonic-gate log_message(MSG_INFO,
12860Sstevel@tonic-gate "repeat ");
12870Sstevel@tonic-gate nbrstk--;
12880Sstevel@tonic-gate } else
12890Sstevel@tonic-gate log_message(MSG_INFO,
12900Sstevel@tonic-gate "[br back?]");
12910Sstevel@tonic-gate } else if (nthentab) {
12920Sstevel@tonic-gate doprintlevel = 1;
12930Sstevel@tonic-gate print_level(level - 1,
12940Sstevel@tonic-gate &doprintlevel);
12950Sstevel@tonic-gate log_message(MSG_INFO, "else ");
12960Sstevel@tonic-gate doprintlevel = 1;
12970Sstevel@tonic-gate thentab[nthentab - 1] = *acf;
12980Sstevel@tonic-gate }
12990Sstevel@tonic-gate } else {
13000Sstevel@tonic-gate if (*acf < (token_t)acf) {
13010Sstevel@tonic-gate brtab[nbrtab++] = *acf;
13020Sstevel@tonic-gate brtab[nbrtab++] = (token_t)acf;
13030Sstevel@tonic-gate }
13040Sstevel@tonic-gate if (endcase_loc == 0 &&
13050Sstevel@tonic-gate case_lit) {
13060Sstevel@tonic-gate endcase_loc = *acf;
13070Sstevel@tonic-gate }
13080Sstevel@tonic-gate }
13090Sstevel@tonic-gate break;
13100Sstevel@tonic-gate
13110Sstevel@tonic-gate case BI_QBR:
13120Sstevel@tonic-gate acf++;
13130Sstevel@tonic-gate if (pass) {
13140Sstevel@tonic-gate if (*acf < (token_t)acf) {
13150Sstevel@tonic-gate if (nbrstk) {
13160Sstevel@tonic-gate doprintlevel = 1;
13170Sstevel@tonic-gate level--;
13180Sstevel@tonic-gate print_level(level,
13190Sstevel@tonic-gate &doprintlevel);
13200Sstevel@tonic-gate log_message(MSG_INFO,
13210Sstevel@tonic-gate "until ");
13220Sstevel@tonic-gate nbrstk--;
13230Sstevel@tonic-gate } else
13240Sstevel@tonic-gate log_message(MSG_INFO,
13250Sstevel@tonic-gate "[br back?]");
13260Sstevel@tonic-gate } else if (nbrstk > 0 &&
13270Sstevel@tonic-gate *acf >= brstk[nbrstk - 1]) {
13280Sstevel@tonic-gate doprintlevel = 1;
13290Sstevel@tonic-gate print_level(level - 1,
13300Sstevel@tonic-gate &doprintlevel);
13310Sstevel@tonic-gate log_message(MSG_INFO,
13320Sstevel@tonic-gate "while ");
13330Sstevel@tonic-gate doprintlevel = 1;
13340Sstevel@tonic-gate } else {
13350Sstevel@tonic-gate log_message(MSG_INFO, "if ");
13360Sstevel@tonic-gate doprintlevel = 1;
13370Sstevel@tonic-gate level++;
13380Sstevel@tonic-gate thentab[nthentab++] = *acf;
13390Sstevel@tonic-gate }
13400Sstevel@tonic-gate } else if (*acf < (token_t)acf) {
13410Sstevel@tonic-gate brtab[nbrtab++] = *acf;
13420Sstevel@tonic-gate brtab[nbrtab++] = (token_t)acf;
13430Sstevel@tonic-gate }
13440Sstevel@tonic-gate break;
13450Sstevel@tonic-gate
13460Sstevel@tonic-gate case BI_BOF:
13470Sstevel@tonic-gate acf++;
13480Sstevel@tonic-gate if (pass) {
13490Sstevel@tonic-gate log_message(MSG_INFO, "of ");
13500Sstevel@tonic-gate endof_loc = *acf;
13510Sstevel@tonic-gate } else if (case_lit == 0) {
13520Sstevel@tonic-gate case_lit = last_lit;
13530Sstevel@tonic-gate }
13540Sstevel@tonic-gate break;
13550Sstevel@tonic-gate
13560Sstevel@tonic-gate case BI_LOOP:
13570Sstevel@tonic-gate case BI_PLOOP:
13580Sstevel@tonic-gate if (pass) {
13590Sstevel@tonic-gate level--;
13600Sstevel@tonic-gate doprintlevel = 1;
13610Sstevel@tonic-gate print_level(level, &doprintlevel);
13620Sstevel@tonic-gate log_message(MSG_INFO, "%s ",
13630Sstevel@tonic-gate bip->bi_name);
13640Sstevel@tonic-gate }
13650Sstevel@tonic-gate acf++;
13660Sstevel@tonic-gate break;
13670Sstevel@tonic-gate
13680Sstevel@tonic-gate default:
13690Sstevel@tonic-gate log_message(MSG_ERROR, "Invalid builtin %s\n",
13700Sstevel@tonic-gate bip->bi_name);
13710Sstevel@tonic-gate }
13720Sstevel@tonic-gate }
13730Sstevel@tonic-gate }
13740Sstevel@tonic-gate }
13750Sstevel@tonic-gate
13760Sstevel@tonic-gate static void
see(fcode_env_t * env)13770Sstevel@tonic-gate see(fcode_env_t *env)
13780Sstevel@tonic-gate {
13790Sstevel@tonic-gate fstack_t d;
13800Sstevel@tonic-gate
13810Sstevel@tonic-gate parse_word(env);
13820Sstevel@tonic-gate dollar_find(env);
13830Sstevel@tonic-gate d = POP(DS);
13840Sstevel@tonic-gate if (d)
13850Sstevel@tonic-gate paren_see(env);
13860Sstevel@tonic-gate else {
13870Sstevel@tonic-gate log_message(MSG_WARN, "?");
13880Sstevel@tonic-gate two_drop(env);
13890Sstevel@tonic-gate }
13900Sstevel@tonic-gate }
13910Sstevel@tonic-gate
13920Sstevel@tonic-gate static acf_t
do_dot_calls(fcode_env_t * env,acf_t acf,void * cacf)13930Sstevel@tonic-gate do_dot_calls(fcode_env_t *env, acf_t acf, void *cacf)
13940Sstevel@tonic-gate {
13950Sstevel@tonic-gate token_t *dptr = ACF_TO_LINK(acf);
13960Sstevel@tonic-gate token_t *wptr = acf;
13970Sstevel@tonic-gate
13980Sstevel@tonic-gate if (*wptr == (token_t)(&do_colon)) {
13990Sstevel@tonic-gate do {
14000Sstevel@tonic-gate if ((acf_t)(*wptr) == (acf_t)cacf)
14010Sstevel@tonic-gate output_acf_name(acf);
14020Sstevel@tonic-gate } while (*wptr++ != (token_t)(&semi_ptr));
14030Sstevel@tonic-gate } else if ((acf_t)(*wptr) == cacf)
14040Sstevel@tonic-gate output_acf_name(acf);
14050Sstevel@tonic-gate else if (wptr == (token_t *)cacf)
14060Sstevel@tonic-gate output_acf_name(acf);
14070Sstevel@tonic-gate return (NULL);
14080Sstevel@tonic-gate }
14090Sstevel@tonic-gate
14100Sstevel@tonic-gate static void
dot_calls(fcode_env_t * env)14110Sstevel@tonic-gate dot_calls(fcode_env_t *env)
14120Sstevel@tonic-gate {
14130Sstevel@tonic-gate acf_t acf = (acf_t)POP(DS);
14140Sstevel@tonic-gate
14150Sstevel@tonic-gate search_all_dictionaries(env, do_dot_calls, acf);
14160Sstevel@tonic-gate output_acf_name(NULL);
14170Sstevel@tonic-gate }
14180Sstevel@tonic-gate
14190Sstevel@tonic-gate static void
dot_pci_space(fcode_env_t * env)14200Sstevel@tonic-gate dot_pci_space(fcode_env_t *env)
14210Sstevel@tonic-gate {
14220Sstevel@tonic-gate fstack_t d = POP(DS);
14230Sstevel@tonic-gate
14240Sstevel@tonic-gate switch ((d >> 24) & 0x3) {
14250Sstevel@tonic-gate case 0: log_message(MSG_INFO, "Config,"); break;
14260Sstevel@tonic-gate case 1: log_message(MSG_INFO, "IO,"); break;
14270Sstevel@tonic-gate case 2: log_message(MSG_INFO, "Memory32,"); break;
14280Sstevel@tonic-gate case 3: log_message(MSG_INFO, "Memory64,"); break;
14290Sstevel@tonic-gate }
14300Sstevel@tonic-gate if (d & 0x80000000)
14310Sstevel@tonic-gate log_message(MSG_INFO, "Not_reloc,");
14320Sstevel@tonic-gate if (d & 0x400000000)
14330Sstevel@tonic-gate log_message(MSG_INFO, "Prefetch,");
14340Sstevel@tonic-gate if (d & 0x200000000)
14350Sstevel@tonic-gate log_message(MSG_INFO, "Alias,");
14360Sstevel@tonic-gate log_message(MSG_INFO, "Bus%d,", (d >> 16) & 0xff);
14370Sstevel@tonic-gate log_message(MSG_INFO, "Dev%d,", (d >> 11) & 0x1f);
14380Sstevel@tonic-gate log_message(MSG_INFO, "Func%d,", (d >> 8) & 0x7);
14390Sstevel@tonic-gate log_message(MSG_INFO, "Reg%x", d & 0xff);
14400Sstevel@tonic-gate log_message(MSG_INFO, "\n");
14410Sstevel@tonic-gate }
14420Sstevel@tonic-gate
14430Sstevel@tonic-gate void
fcode_debug(fcode_env_t * env)14440Sstevel@tonic-gate fcode_debug(fcode_env_t *env)
14450Sstevel@tonic-gate {
14460Sstevel@tonic-gate PUSH(DS, (fstack_t)(&env->fcode_debug));
14470Sstevel@tonic-gate }
14480Sstevel@tonic-gate
14490Sstevel@tonic-gate static void
base_addr(fcode_env_t * env)14500Sstevel@tonic-gate base_addr(fcode_env_t *env)
14510Sstevel@tonic-gate {
14520Sstevel@tonic-gate PUSH(DS, (fstack_t)env->base);
14530Sstevel@tonic-gate }
14540Sstevel@tonic-gate
14550Sstevel@tonic-gate static int mw_valid;
14560Sstevel@tonic-gate static int mw_size;
14570Sstevel@tonic-gate static void *mw_addr;
14580Sstevel@tonic-gate static fstack_t mw_value;
14590Sstevel@tonic-gate static fstack_t mw_lastvalue;
14600Sstevel@tonic-gate
14610Sstevel@tonic-gate static fstack_t
mw_fetch(void)14620Sstevel@tonic-gate mw_fetch(void)
14630Sstevel@tonic-gate {
14640Sstevel@tonic-gate switch (mw_size) {
14650Sstevel@tonic-gate case 1: return (*((uint8_t *)mw_addr));
14660Sstevel@tonic-gate case 2: return (*((uint16_t *)mw_addr));
14670Sstevel@tonic-gate case 4: return (*((uint32_t *)mw_addr));
14680Sstevel@tonic-gate case 8: return (*((uint64_t *)mw_addr));
14690Sstevel@tonic-gate }
14700Sstevel@tonic-gate return (0);
14710Sstevel@tonic-gate }
14720Sstevel@tonic-gate
14730Sstevel@tonic-gate void
do_memory_watch(fcode_env_t * env)14740Sstevel@tonic-gate do_memory_watch(fcode_env_t *env)
14750Sstevel@tonic-gate {
14760Sstevel@tonic-gate fstack_t value;
14770Sstevel@tonic-gate
14780Sstevel@tonic-gate if (!mw_valid)
14790Sstevel@tonic-gate return;
14800Sstevel@tonic-gate value = mw_fetch();
14810Sstevel@tonic-gate if (value != mw_lastvalue) {
14820Sstevel@tonic-gate if (mw_valid == 1 || mw_value == value) {
14830Sstevel@tonic-gate log_message(MSG_INFO,
14840Sstevel@tonic-gate "memory-watch: %p/%d: %llx -> %llx\n",
14850Sstevel@tonic-gate mw_addr, mw_size, (uint64_t)mw_lastvalue,
14860Sstevel@tonic-gate (uint64_t)value);
14870Sstevel@tonic-gate do_fclib_step(env);
14880Sstevel@tonic-gate }
14890Sstevel@tonic-gate mw_lastvalue = value;
14900Sstevel@tonic-gate }
14910Sstevel@tonic-gate }
14920Sstevel@tonic-gate
14930Sstevel@tonic-gate static void
set_memory_watch(fcode_env_t * env,int type,int size,void * addr,fstack_t value)14940Sstevel@tonic-gate set_memory_watch(fcode_env_t *env, int type, int size, void *addr,
14950Sstevel@tonic-gate fstack_t value)
14960Sstevel@tonic-gate {
14970Sstevel@tonic-gate switch (size) {
14980Sstevel@tonic-gate case 1: case 2: case 4: case 8:
14990Sstevel@tonic-gate break;
15000Sstevel@tonic-gate default:
15010Sstevel@tonic-gate log_message(MSG_ERROR, "set_memory_watch: invalid size: %d\n",
15020Sstevel@tonic-gate size);
15030Sstevel@tonic-gate return;
15040Sstevel@tonic-gate }
15050Sstevel@tonic-gate mw_valid = type;
15060Sstevel@tonic-gate mw_size = size;
15070Sstevel@tonic-gate mw_addr = addr;
15080Sstevel@tonic-gate mw_value = value;
15090Sstevel@tonic-gate mw_lastvalue = mw_fetch();
15100Sstevel@tonic-gate }
15110Sstevel@tonic-gate
15120Sstevel@tonic-gate static void
memory_watch(fcode_env_t * env)15130Sstevel@tonic-gate memory_watch(fcode_env_t *env)
15140Sstevel@tonic-gate {
15150Sstevel@tonic-gate int size = POP(DS);
15160Sstevel@tonic-gate void *addr = (void *)POP(DS);
15170Sstevel@tonic-gate
15180Sstevel@tonic-gate set_memory_watch(env, 1, size, addr, 0);
15190Sstevel@tonic-gate }
15200Sstevel@tonic-gate
15210Sstevel@tonic-gate static void
memory_watch_value(fcode_env_t * env)15220Sstevel@tonic-gate memory_watch_value(fcode_env_t *env)
15230Sstevel@tonic-gate {
15240Sstevel@tonic-gate int size = POP(DS);
15250Sstevel@tonic-gate void *addr = (void *)POP(DS);
15260Sstevel@tonic-gate fstack_t value = POP(DS);
15270Sstevel@tonic-gate
15280Sstevel@tonic-gate set_memory_watch(env, 2, size, addr, value);
15290Sstevel@tonic-gate }
15300Sstevel@tonic-gate
15310Sstevel@tonic-gate static void
memory_watch_clear(fcode_env_t * env)15320Sstevel@tonic-gate memory_watch_clear(fcode_env_t *env)
15330Sstevel@tonic-gate {
15340Sstevel@tonic-gate mw_valid = 0;
15350Sstevel@tonic-gate }
15360Sstevel@tonic-gate
15370Sstevel@tonic-gate static void
vsearch(fcode_env_t * env)15380Sstevel@tonic-gate vsearch(fcode_env_t *env)
15390Sstevel@tonic-gate {
15400Sstevel@tonic-gate fstack_t value;
15410Sstevel@tonic-gate int size = POP(DS);
15420Sstevel@tonic-gate fstack_t match_value = POP(DS);
15430Sstevel@tonic-gate uchar_t *toaddr = (uchar_t *)POP(DS);
15440Sstevel@tonic-gate uchar_t *fromaddr = (uchar_t *)POP(DS);
15450Sstevel@tonic-gate
15460Sstevel@tonic-gate log_message(MSG_INFO, "%p to %p by %d looking for %llx\n", fromaddr,
15470Sstevel@tonic-gate toaddr, size, (uint64_t)match_value);
15480Sstevel@tonic-gate for (; fromaddr < toaddr; fromaddr += size) {
15490Sstevel@tonic-gate switch (size) {
15500Sstevel@tonic-gate case 1: value = *((uint8_t *)fromaddr); break;
15510Sstevel@tonic-gate case 2: value = *((uint16_t *)fromaddr); break;
15520Sstevel@tonic-gate case 4: value = *((uint32_t *)fromaddr); break;
15530Sstevel@tonic-gate case 8: value = *((uint64_t *)fromaddr); break;
15540Sstevel@tonic-gate default:
15550Sstevel@tonic-gate log_message(MSG_INFO, "Invalid size: %d\n", size);
15560Sstevel@tonic-gate return;
15570Sstevel@tonic-gate }
15580Sstevel@tonic-gate if (value == match_value)
15590Sstevel@tonic-gate log_message(MSG_INFO, "%p\n", fromaddr);
15600Sstevel@tonic-gate }
15610Sstevel@tonic-gate }
15620Sstevel@tonic-gate
15630Sstevel@tonic-gate #pragma init(_init)
15640Sstevel@tonic-gate
15650Sstevel@tonic-gate static void
_init(void)15660Sstevel@tonic-gate _init(void)
15670Sstevel@tonic-gate {
15680Sstevel@tonic-gate fcode_env_t *env = initial_env;
15690Sstevel@tonic-gate
15700Sstevel@tonic-gate ASSERT(env);
15710Sstevel@tonic-gate NOTICE;
15720Sstevel@tonic-gate
15730Sstevel@tonic-gate FORTH(IMMEDIATE, "words", words);
15740Sstevel@tonic-gate FORTH(IMMEDIATE, "dump-words", dump_words);
15750Sstevel@tonic-gate FORTH(IMMEDIATE, "dump-dict", dump_dictionary);
15760Sstevel@tonic-gate FORTH(IMMEDIATE, "dump-table", dump_table);
15770Sstevel@tonic-gate FORTH(0, "debugf", debugf);
15780Sstevel@tonic-gate FORTH(0, ".debugf", dot_debugf);
15790Sstevel@tonic-gate FORTH(0, "set-debugf", set_debugf);
15800Sstevel@tonic-gate FORTH(0, "debugf?", debugf_qmark);
15810Sstevel@tonic-gate FORTH(0, "control", control);
15820Sstevel@tonic-gate FORTH(0, "dump", dump);
15830Sstevel@tonic-gate FORTH(IMMEDIATE, "showstack", show_stack);
15840Sstevel@tonic-gate FORTH(IMMEDIATE, "sifting", sifting);
15850Sstevel@tonic-gate FORTH(IMMEDIATE, "ctrace", ctrace);
15860Sstevel@tonic-gate FORTH(IMMEDIATE, "ftrace", ftrace);
15870Sstevel@tonic-gate FORTH(0, "see", see);
15880Sstevel@tonic-gate FORTH(0, "(see)", paren_see);
15890Sstevel@tonic-gate FORTH(0, "base-addr", base_addr);
15900Sstevel@tonic-gate FORTH(0, "smatch", smatch);
15910Sstevel@tonic-gate FORTH(0, ".calls", dot_calls);
15920Sstevel@tonic-gate FORTH(0, ".pci-space", dot_pci_space);
15930Sstevel@tonic-gate FORTH(0, "(debug)", paren_debug);
15940Sstevel@tonic-gate FORTH(0, "debug", debug);
15950Sstevel@tonic-gate FORTH(0, ".debug", dot_debug);
15960Sstevel@tonic-gate FORTH(0, "undebug", undebug);
15970Sstevel@tonic-gate FORTH(0, "memory-watch", memory_watch);
15980Sstevel@tonic-gate FORTH(0, "memory-watch-value", memory_watch_value);
15990Sstevel@tonic-gate FORTH(0, "memory-watch-clear", memory_watch_clear);
16000Sstevel@tonic-gate FORTH(0, "vsearch", vsearch);
16010Sstevel@tonic-gate }
1602