17c478bd9Sstevel@tonic-gate /*
27c478bd9Sstevel@tonic-gate * CDDL HEADER START
37c478bd9Sstevel@tonic-gate *
47c478bd9Sstevel@tonic-gate * The contents of this file are subject to the terms of the
57c478bd9Sstevel@tonic-gate * Common Development and Distribution License, Version 1.0 only
67c478bd9Sstevel@tonic-gate * (the "License"). You may not use this file except in compliance
77c478bd9Sstevel@tonic-gate * with the License.
87c478bd9Sstevel@tonic-gate *
97c478bd9Sstevel@tonic-gate * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
107c478bd9Sstevel@tonic-gate * or http://www.opensolaris.org/os/licensing.
117c478bd9Sstevel@tonic-gate * See the License for the specific language governing permissions
127c478bd9Sstevel@tonic-gate * and limitations under the License.
137c478bd9Sstevel@tonic-gate *
147c478bd9Sstevel@tonic-gate * When distributing Covered Code, include this CDDL HEADER in each
157c478bd9Sstevel@tonic-gate * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
167c478bd9Sstevel@tonic-gate * If applicable, add the following below this CDDL HEADER, with the
177c478bd9Sstevel@tonic-gate * fields enclosed by brackets "[]" replaced with your own identifying
187c478bd9Sstevel@tonic-gate * information: Portions Copyright [yyyy] [name of copyright owner]
197c478bd9Sstevel@tonic-gate *
207c478bd9Sstevel@tonic-gate * CDDL HEADER END
217c478bd9Sstevel@tonic-gate */
227c478bd9Sstevel@tonic-gate /*
23360e6f5eSmathue * Copyright 2005 Sun Microsystems, Inc. All rights reserved.
247c478bd9Sstevel@tonic-gate * Use is subject to license terms.
257c478bd9Sstevel@tonic-gate */
267c478bd9Sstevel@tonic-gate
277c478bd9Sstevel@tonic-gate #include <stdio.h>
287c478bd9Sstevel@tonic-gate #include <string.h>
297c478bd9Sstevel@tonic-gate #include <stdlib.h>
307c478bd9Sstevel@tonic-gate #include <stdarg.h>
317c478bd9Sstevel@tonic-gate #include <unistd.h>
327c478bd9Sstevel@tonic-gate #include <errno.h>
337c478bd9Sstevel@tonic-gate #include <ctype.h>
347c478bd9Sstevel@tonic-gate
357c478bd9Sstevel@tonic-gate #include <fcode/private.h>
367c478bd9Sstevel@tonic-gate #include <fcode/log.h>
377c478bd9Sstevel@tonic-gate
387c478bd9Sstevel@tonic-gate #ifndef DEBUG_LVL
397c478bd9Sstevel@tonic-gate #define DEBUG_LVL 0
407c478bd9Sstevel@tonic-gate #endif
417c478bd9Sstevel@tonic-gate
427c478bd9Sstevel@tonic-gate struct bitab {
437c478bd9Sstevel@tonic-gate token_t bi_ptr;
447c478bd9Sstevel@tonic-gate char *bi_name;
457c478bd9Sstevel@tonic-gate int bi_type;
467c478bd9Sstevel@tonic-gate };
477c478bd9Sstevel@tonic-gate
487c478bd9Sstevel@tonic-gate struct bitab *lookup_builtin(token_t);
497c478bd9Sstevel@tonic-gate
507c478bd9Sstevel@tonic-gate static int debug_level = DEBUG_LVL;
517c478bd9Sstevel@tonic-gate
527c478bd9Sstevel@tonic-gate void
set_interpreter_debug_level(long lvl)537c478bd9Sstevel@tonic-gate set_interpreter_debug_level(long lvl)
547c478bd9Sstevel@tonic-gate {
557c478bd9Sstevel@tonic-gate debug_level = lvl;
567c478bd9Sstevel@tonic-gate }
577c478bd9Sstevel@tonic-gate
587c478bd9Sstevel@tonic-gate long
get_interpreter_debug_level(void)597c478bd9Sstevel@tonic-gate get_interpreter_debug_level(void)
607c478bd9Sstevel@tonic-gate {
617c478bd9Sstevel@tonic-gate return (debug_level);
627c478bd9Sstevel@tonic-gate }
637c478bd9Sstevel@tonic-gate
647c478bd9Sstevel@tonic-gate void
output_data_stack(fcode_env_t * env,int msglevel)657c478bd9Sstevel@tonic-gate output_data_stack(fcode_env_t *env, int msglevel)
667c478bd9Sstevel@tonic-gate {
677c478bd9Sstevel@tonic-gate int i;
687c478bd9Sstevel@tonic-gate
697c478bd9Sstevel@tonic-gate log_message(msglevel, "( ");
707c478bd9Sstevel@tonic-gate if (DS > env->ds0) {
717c478bd9Sstevel@tonic-gate for (i = 0; i < (DS - env->ds0); i++)
727c478bd9Sstevel@tonic-gate log_message(msglevel, "%llx ",
737c478bd9Sstevel@tonic-gate (uint64_t)(env->ds0[i + 1]));
747c478bd9Sstevel@tonic-gate } else
757c478bd9Sstevel@tonic-gate log_message(msglevel, "<empty> ");
767c478bd9Sstevel@tonic-gate log_message(msglevel, ") ");
777c478bd9Sstevel@tonic-gate }
787c478bd9Sstevel@tonic-gate
797c478bd9Sstevel@tonic-gate void
output_return_stack(fcode_env_t * env,int show_wa,int msglevel)807c478bd9Sstevel@tonic-gate output_return_stack(fcode_env_t *env, int show_wa, int msglevel)
817c478bd9Sstevel@tonic-gate {
827c478bd9Sstevel@tonic-gate int i;
837c478bd9Sstevel@tonic-gate int anyout = 0;
847c478bd9Sstevel@tonic-gate
857c478bd9Sstevel@tonic-gate log_message(msglevel, "R:( ");
867c478bd9Sstevel@tonic-gate if (show_wa) {
877c478bd9Sstevel@tonic-gate log_message(msglevel, "%s ",
887c478bd9Sstevel@tonic-gate acf_backup_search(env, (acf_t)WA));
897c478bd9Sstevel@tonic-gate anyout++;
907c478bd9Sstevel@tonic-gate }
917c478bd9Sstevel@tonic-gate if (IP) {
927c478bd9Sstevel@tonic-gate anyout++;
937c478bd9Sstevel@tonic-gate log_message(msglevel, "%s ", acf_backup_search(env, IP));
947c478bd9Sstevel@tonic-gate }
957c478bd9Sstevel@tonic-gate for (i = (RS - env->rs0) - 1; i > 0; i--) {
967c478bd9Sstevel@tonic-gate anyout++;
977c478bd9Sstevel@tonic-gate log_message(msglevel, "%s ",
98*09e6639bSToomas Soome acf_backup_search(env, (acf_t)env->rs0[i+1]));
997c478bd9Sstevel@tonic-gate }
1007c478bd9Sstevel@tonic-gate if (!anyout)
1017c478bd9Sstevel@tonic-gate log_message(msglevel, "<empty> ");
1027c478bd9Sstevel@tonic-gate log_message(msglevel, ") ");
1037c478bd9Sstevel@tonic-gate }
1047c478bd9Sstevel@tonic-gate
1057c478bd9Sstevel@tonic-gate void
dump_comma(fcode_env_t * env,char * type)1067c478bd9Sstevel@tonic-gate dump_comma(fcode_env_t *env, char *type)
1077c478bd9Sstevel@tonic-gate {
1087c478bd9Sstevel@tonic-gate xforth_t d;
1097c478bd9Sstevel@tonic-gate
1107c478bd9Sstevel@tonic-gate if (strcmp(type, "x,") == 0)
1117c478bd9Sstevel@tonic-gate d = peek_xforth(env);
1127c478bd9Sstevel@tonic-gate else
1137c478bd9Sstevel@tonic-gate d = TOS;
1147c478bd9Sstevel@tonic-gate log_message(MSG_FC_DEBUG, "%s %p, %llx\n", type, HERE, (uint64_t)d);
1157c478bd9Sstevel@tonic-gate }
1167c478bd9Sstevel@tonic-gate
1177c478bd9Sstevel@tonic-gate static int ndebug_names;
1187c478bd9Sstevel@tonic-gate #define MAXDEBUG_NAMES 10
1197c478bd9Sstevel@tonic-gate static char *debug_names[MAXDEBUG_NAMES];
1207c478bd9Sstevel@tonic-gate
1217c478bd9Sstevel@tonic-gate static int ndebug_acfs;
1227c478bd9Sstevel@tonic-gate #define MAXDEBUG_ACFS 10
1237c478bd9Sstevel@tonic-gate static acf_t debug_acfs[MAXDEBUG_ACFS];
1247c478bd9Sstevel@tonic-gate
1257c478bd9Sstevel@tonic-gate void
add_debug_acf(fcode_env_t * env,acf_t acf)1267c478bd9Sstevel@tonic-gate add_debug_acf(fcode_env_t *env, acf_t acf)
1277c478bd9Sstevel@tonic-gate {
1287c478bd9Sstevel@tonic-gate int i;
1297c478bd9Sstevel@tonic-gate
1307c478bd9Sstevel@tonic-gate for (i = 0; i < ndebug_acfs; i++)
1317c478bd9Sstevel@tonic-gate if (acf == debug_acfs[i])
1327c478bd9Sstevel@tonic-gate return;
1337c478bd9Sstevel@tonic-gate
1347c478bd9Sstevel@tonic-gate if (!within_dictionary(env, acf))
1357c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "Can't debug builtin\n");
1367c478bd9Sstevel@tonic-gate else if (ndebug_acfs >= MAXDEBUG_ACFS)
1377c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "Too many debug ACF's\n");
1387c478bd9Sstevel@tonic-gate else {
1397c478bd9Sstevel@tonic-gate debug_acfs[ndebug_acfs++] = acf;
1407c478bd9Sstevel@tonic-gate *LINK_TO_FLAGS(ACF_TO_LINK(acf)) |= FLAG_DEBUG;
1417c478bd9Sstevel@tonic-gate }
1427c478bd9Sstevel@tonic-gate }
1437c478bd9Sstevel@tonic-gate
1447c478bd9Sstevel@tonic-gate static void
paren_debug(fcode_env_t * env)1457c478bd9Sstevel@tonic-gate paren_debug(fcode_env_t *env)
1467c478bd9Sstevel@tonic-gate {
1477c478bd9Sstevel@tonic-gate acf_t acf;
1487c478bd9Sstevel@tonic-gate
1497c478bd9Sstevel@tonic-gate acf = (acf_t)POP(DS);
1507c478bd9Sstevel@tonic-gate if (!within_dictionary(env, acf)) {
1517c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "acf: %llx not in dictionary\n",
1527c478bd9Sstevel@tonic-gate (uint64_t)acf);
1537c478bd9Sstevel@tonic-gate return;
1547c478bd9Sstevel@tonic-gate }
1557c478bd9Sstevel@tonic-gate if ((acf_t)_ALIGN(acf, token_t) != acf) {
1567c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "acf: %llx not aligned\n",
1577c478bd9Sstevel@tonic-gate (uint64_t)acf);
1587c478bd9Sstevel@tonic-gate return;
1597c478bd9Sstevel@tonic-gate }
1607c478bd9Sstevel@tonic-gate if (*acf != (token_t)(&do_colon)) {
1617c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "acf: %llx not a colon-def\n",
1627c478bd9Sstevel@tonic-gate (uint64_t)acf);
1637c478bd9Sstevel@tonic-gate return;
1647c478bd9Sstevel@tonic-gate }
1657c478bd9Sstevel@tonic-gate add_debug_acf(env, acf);
1667c478bd9Sstevel@tonic-gate }
1677c478bd9Sstevel@tonic-gate
1687c478bd9Sstevel@tonic-gate static void
debug(fcode_env_t * env)1697c478bd9Sstevel@tonic-gate debug(fcode_env_t *env)
1707c478bd9Sstevel@tonic-gate {
1717c478bd9Sstevel@tonic-gate fstack_t d;
1727c478bd9Sstevel@tonic-gate char *word;
1737c478bd9Sstevel@tonic-gate acf_t acf;
1747c478bd9Sstevel@tonic-gate
1757c478bd9Sstevel@tonic-gate parse_word(env);
1767c478bd9Sstevel@tonic-gate dollar_find(env);
1777c478bd9Sstevel@tonic-gate d = POP(DS);
1787c478bd9Sstevel@tonic-gate if (d) {
1797c478bd9Sstevel@tonic-gate acf = (acf_t)POP(DS);
1807c478bd9Sstevel@tonic-gate add_debug_acf(env, acf);
1817c478bd9Sstevel@tonic-gate } else if (ndebug_names >= MAXDEBUG_NAMES) {
1827c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "Too many forward debug words\n");
1837c478bd9Sstevel@tonic-gate two_drop(env);
1847c478bd9Sstevel@tonic-gate } else {
1857c478bd9Sstevel@tonic-gate word = pop_a_duped_string(env, NULL);
1867c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "Forward defined word: %s\n", word);
1877c478bd9Sstevel@tonic-gate debug_names[ndebug_names++] = word;
1887c478bd9Sstevel@tonic-gate }
1897c478bd9Sstevel@tonic-gate }
1907c478bd9Sstevel@tonic-gate
1917c478bd9Sstevel@tonic-gate /*
1927c478bd9Sstevel@tonic-gate * Eliminate dups and add vocabulary forth to end if not already on list.
1937c478bd9Sstevel@tonic-gate */
1947c478bd9Sstevel@tonic-gate static void
order_to_dict_list(fcode_env_t * env,token_t * order[])1957c478bd9Sstevel@tonic-gate order_to_dict_list(fcode_env_t *env, token_t *order[])
1967c478bd9Sstevel@tonic-gate {
1977c478bd9Sstevel@tonic-gate int i, j, norder = 0;
1987c478bd9Sstevel@tonic-gate
1997c478bd9Sstevel@tonic-gate if (env->current)
2007c478bd9Sstevel@tonic-gate order[norder++] = env->current;
2017c478bd9Sstevel@tonic-gate for (i = env->order_depth; i >= 0; i--) {
2027c478bd9Sstevel@tonic-gate for (j = 0; j < norder && order[j] != env->order[i]; j++)
2037c478bd9Sstevel@tonic-gate ;
2047c478bd9Sstevel@tonic-gate if (j == norder)
2057c478bd9Sstevel@tonic-gate order[norder++] = env->order[i];
2067c478bd9Sstevel@tonic-gate }
2077c478bd9Sstevel@tonic-gate for (j = 0; j < norder && order[j] != (token_t *)&env->forth_voc_link;
2087c478bd9Sstevel@tonic-gate j++)
2097c478bd9Sstevel@tonic-gate ;
2107c478bd9Sstevel@tonic-gate if (j == norder)
2117c478bd9Sstevel@tonic-gate order[norder++] = (token_t *)&env->forth_voc_link;
2127c478bd9Sstevel@tonic-gate order[norder] = NULL;
2137c478bd9Sstevel@tonic-gate }
2147c478bd9Sstevel@tonic-gate
2157c478bd9Sstevel@tonic-gate static acf_t
search_all_dictionaries(fcode_env_t * env,acf_t (* fn)(fcode_env_t *,acf_t,void *),void * arg)2167c478bd9Sstevel@tonic-gate search_all_dictionaries(fcode_env_t *env,
2177c478bd9Sstevel@tonic-gate acf_t (*fn)(fcode_env_t *, acf_t, void *),
2187c478bd9Sstevel@tonic-gate void *arg)
2197c478bd9Sstevel@tonic-gate {
2207c478bd9Sstevel@tonic-gate token_t *order[MAX_ORDER+1];
2217c478bd9Sstevel@tonic-gate int i;
2227c478bd9Sstevel@tonic-gate token_t *dptr;
2237c478bd9Sstevel@tonic-gate acf_t acf;
2247c478bd9Sstevel@tonic-gate
2257c478bd9Sstevel@tonic-gate order_to_dict_list(env, order);
2267c478bd9Sstevel@tonic-gate for (i = 0; (dptr = order[i]) != NULL; i++) {
2277c478bd9Sstevel@tonic-gate for (dptr = (token_t *)(*dptr); dptr;
2287c478bd9Sstevel@tonic-gate dptr = (token_t *)(*dptr))
2297c478bd9Sstevel@tonic-gate if ((acf = (*fn)(env, LINK_TO_ACF(dptr), arg)) != NULL)
2307c478bd9Sstevel@tonic-gate return (acf);
2317c478bd9Sstevel@tonic-gate }
2327c478bd9Sstevel@tonic-gate return (NULL);
2337c478bd9Sstevel@tonic-gate }
2347c478bd9Sstevel@tonic-gate
2357c478bd9Sstevel@tonic-gate char *
acf_to_str(acf_t acf)2367c478bd9Sstevel@tonic-gate acf_to_str(acf_t acf)
2377c478bd9Sstevel@tonic-gate {
2387c478bd9Sstevel@tonic-gate static char msg[(sizeof (acf) * 2) + 3];
2397c478bd9Sstevel@tonic-gate
240*09e6639bSToomas Soome (void) sprintf(msg, "(%08p)", acf);
2417c478bd9Sstevel@tonic-gate return (msg);
2427c478bd9Sstevel@tonic-gate }
2437c478bd9Sstevel@tonic-gate
2447c478bd9Sstevel@tonic-gate char *
get_name_or_acf(token_t * dptr)2457c478bd9Sstevel@tonic-gate get_name_or_acf(token_t *dptr)
2467c478bd9Sstevel@tonic-gate {
2477c478bd9Sstevel@tonic-gate char *name;
2487c478bd9Sstevel@tonic-gate
2497c478bd9Sstevel@tonic-gate if ((name = get_name(dptr)) != NULL)
2507c478bd9Sstevel@tonic-gate return (name);
2517c478bd9Sstevel@tonic-gate return (acf_to_str(LINK_TO_ACF(dptr)));
2527c478bd9Sstevel@tonic-gate }
2537c478bd9Sstevel@tonic-gate
2547c478bd9Sstevel@tonic-gate static void
output_acf_name(acf_t acf)2557c478bd9Sstevel@tonic-gate output_acf_name(acf_t acf)
2567c478bd9Sstevel@tonic-gate {
2577c478bd9Sstevel@tonic-gate char *name;
2587c478bd9Sstevel@tonic-gate token_t *dptr;
2597c478bd9Sstevel@tonic-gate static int acf_count = 0;
2607c478bd9Sstevel@tonic-gate
2617c478bd9Sstevel@tonic-gate if (acf == NULL) {
2627c478bd9Sstevel@tonic-gate if (acf_count)
2637c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "\n");
2647c478bd9Sstevel@tonic-gate acf_count = 0;
2657c478bd9Sstevel@tonic-gate return;
2667c478bd9Sstevel@tonic-gate }
2677c478bd9Sstevel@tonic-gate dptr = ACF_TO_LINK(acf);
2687c478bd9Sstevel@tonic-gate if ((name = get_name(dptr)) == NULL)
2697c478bd9Sstevel@tonic-gate name = "<noname>";
2707c478bd9Sstevel@tonic-gate
2717c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "%24s (%08p)", name, acf);
2727c478bd9Sstevel@tonic-gate if (++acf_count >= 2) {
2737c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "\n");
2747c478bd9Sstevel@tonic-gate acf_count = 0;
2757c478bd9Sstevel@tonic-gate } else
2767c478bd9Sstevel@tonic-gate log_message(MSG_INFO, " ");
2777c478bd9Sstevel@tonic-gate }
2787c478bd9Sstevel@tonic-gate
2797c478bd9Sstevel@tonic-gate static void
dot_debug(fcode_env_t * env)2807c478bd9Sstevel@tonic-gate dot_debug(fcode_env_t *env)
2817c478bd9Sstevel@tonic-gate {
2827c478bd9Sstevel@tonic-gate int i;
2837c478bd9Sstevel@tonic-gate token_t *dptr;
2847c478bd9Sstevel@tonic-gate
2857c478bd9Sstevel@tonic-gate if (ndebug_names == 0)
2867c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "No forward debug words\n");
2877c478bd9Sstevel@tonic-gate else {
2887c478bd9Sstevel@tonic-gate for (i = 0; i < ndebug_names; i++)
2897c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "%s Forward\n", debug_names[i]);
2907c478bd9Sstevel@tonic-gate }
2917c478bd9Sstevel@tonic-gate if (ndebug_acfs == 0)
2927c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "No debug words\n");
2937c478bd9Sstevel@tonic-gate else {
2947c478bd9Sstevel@tonic-gate for (i = 0; i < ndebug_acfs; i++)
2957c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "%s\n",
2967c478bd9Sstevel@tonic-gate get_name_or_acf(ACF_TO_LINK(debug_acfs[i])));
2977c478bd9Sstevel@tonic-gate }
2987c478bd9Sstevel@tonic-gate }
2997c478bd9Sstevel@tonic-gate
3007c478bd9Sstevel@tonic-gate static void
do_undebug(fcode_env_t * env,char * name)3017c478bd9Sstevel@tonic-gate do_undebug(fcode_env_t *env, char *name)
3027c478bd9Sstevel@tonic-gate {
3037c478bd9Sstevel@tonic-gate int i;
3047c478bd9Sstevel@tonic-gate
3057c478bd9Sstevel@tonic-gate for (i = 0; i < ndebug_names; i++) {
3067c478bd9Sstevel@tonic-gate if (strcmp(debug_names[i], name) == 0) {
3077c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "Undebugging forward word %s\n",
3087c478bd9Sstevel@tonic-gate name);
3097c478bd9Sstevel@tonic-gate FREE(debug_names[i]);
3107c478bd9Sstevel@tonic-gate for (i++; i < ndebug_names; i++)
3117c478bd9Sstevel@tonic-gate debug_names[i - 1] = debug_names[i];
3127c478bd9Sstevel@tonic-gate ndebug_names--;
3137c478bd9Sstevel@tonic-gate break;
3147c478bd9Sstevel@tonic-gate }
3157c478bd9Sstevel@tonic-gate }
3167c478bd9Sstevel@tonic-gate }
3177c478bd9Sstevel@tonic-gate
3187c478bd9Sstevel@tonic-gate static void
undebug(fcode_env_t * env)3197c478bd9Sstevel@tonic-gate undebug(fcode_env_t *env)
3207c478bd9Sstevel@tonic-gate {
3217c478bd9Sstevel@tonic-gate fstack_t d;
3227c478bd9Sstevel@tonic-gate acf_t acf;
3237c478bd9Sstevel@tonic-gate flag_t *flagp;
3247c478bd9Sstevel@tonic-gate char *name;
3257c478bd9Sstevel@tonic-gate int i, j;
3267c478bd9Sstevel@tonic-gate
3277c478bd9Sstevel@tonic-gate parse_word(env);
3287c478bd9Sstevel@tonic-gate two_dup(env);
3297c478bd9Sstevel@tonic-gate dollar_find(env);
3307c478bd9Sstevel@tonic-gate d = POP(DS);
3317c478bd9Sstevel@tonic-gate if (d) {
3327c478bd9Sstevel@tonic-gate acf = (acf_t)POP(DS);
3337c478bd9Sstevel@tonic-gate flagp = LINK_TO_FLAGS(ACF_TO_LINK(acf));
3347c478bd9Sstevel@tonic-gate if ((*flagp & FLAG_DEBUG) == 0)
3357c478bd9Sstevel@tonic-gate log_message(MSG_WARN, "Word not debugged?\n");
3367c478bd9Sstevel@tonic-gate else {
3377c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "Undebugging acf: %p\n", acf);
3387c478bd9Sstevel@tonic-gate *flagp &= ~FLAG_DEBUG;
3397c478bd9Sstevel@tonic-gate for (i = 0; i < ndebug_acfs; i++) {
3407c478bd9Sstevel@tonic-gate if (debug_acfs[i] == acf) {
3417c478bd9Sstevel@tonic-gate for (j = i + 1; j < ndebug_acfs; j++)
3427c478bd9Sstevel@tonic-gate debug_acfs[j-1] = debug_acfs[j];
3437c478bd9Sstevel@tonic-gate ndebug_acfs--;
3447c478bd9Sstevel@tonic-gate break;
3457c478bd9Sstevel@tonic-gate }
3467c478bd9Sstevel@tonic-gate }
3477c478bd9Sstevel@tonic-gate }
3487c478bd9Sstevel@tonic-gate } else
3497c478bd9Sstevel@tonic-gate two_drop(env);
3507c478bd9Sstevel@tonic-gate name = pop_a_string(env, NULL);
3517c478bd9Sstevel@tonic-gate do_undebug(env, name);
3527c478bd9Sstevel@tonic-gate }
3537c478bd9Sstevel@tonic-gate
3547c478bd9Sstevel@tonic-gate int
name_is_debugged(fcode_env_t * env,char * name)3557c478bd9Sstevel@tonic-gate name_is_debugged(fcode_env_t *env, char *name)
3567c478bd9Sstevel@tonic-gate {
3577c478bd9Sstevel@tonic-gate int i;
3587c478bd9Sstevel@tonic-gate
3597c478bd9Sstevel@tonic-gate if (ndebug_names <= 0)
3607c478bd9Sstevel@tonic-gate return (0);
3617c478bd9Sstevel@tonic-gate for (i = 0; i < ndebug_names; i++)
3627c478bd9Sstevel@tonic-gate if (strcmp(debug_names[i], name) == 0)
3637c478bd9Sstevel@tonic-gate return (1);
3647c478bd9Sstevel@tonic-gate return (0);
3657c478bd9Sstevel@tonic-gate }
3667c478bd9Sstevel@tonic-gate
3677c478bd9Sstevel@tonic-gate /*
3687c478bd9Sstevel@tonic-gate * This is complicated by being given ACF's to temporary compile words which
3697c478bd9Sstevel@tonic-gate * don't have a header.
3707c478bd9Sstevel@tonic-gate */
3717c478bd9Sstevel@tonic-gate int
is_debug_word(fcode_env_t * env,acf_t acf)3727c478bd9Sstevel@tonic-gate is_debug_word(fcode_env_t *env, acf_t acf)
3737c478bd9Sstevel@tonic-gate {
3747c478bd9Sstevel@tonic-gate flag_t *flagp;
3757c478bd9Sstevel@tonic-gate int i;
3767c478bd9Sstevel@tonic-gate
3777c478bd9Sstevel@tonic-gate /* check to see if any words are being debugged */
3787c478bd9Sstevel@tonic-gate if (ndebug_acfs == 0)
3797c478bd9Sstevel@tonic-gate return (0);
3807c478bd9Sstevel@tonic-gate
3817c478bd9Sstevel@tonic-gate /* only words in dictionary can be debugged */
3827c478bd9Sstevel@tonic-gate if (!within_dictionary(env, acf))
3837c478bd9Sstevel@tonic-gate return (0);
3847c478bd9Sstevel@tonic-gate
3857c478bd9Sstevel@tonic-gate /* check that word has "FLAG_DEBUG" on */
3867c478bd9Sstevel@tonic-gate flagp = LINK_TO_FLAGS(ACF_TO_LINK(acf));
3877c478bd9Sstevel@tonic-gate if ((*flagp & FLAG_DEBUG) == 0)
3887c478bd9Sstevel@tonic-gate return (0);
3897c478bd9Sstevel@tonic-gate
3907c478bd9Sstevel@tonic-gate /* look in table of debug acf's */
3917c478bd9Sstevel@tonic-gate for (i = 0; i < ndebug_acfs; i++)
3927c478bd9Sstevel@tonic-gate if (debug_acfs[i] == acf)
3937c478bd9Sstevel@tonic-gate return (1);
3947c478bd9Sstevel@tonic-gate return (0);
3957c478bd9Sstevel@tonic-gate }
3967c478bd9Sstevel@tonic-gate
3977c478bd9Sstevel@tonic-gate #define MAX_DEBUG_STACK 100
3987c478bd9Sstevel@tonic-gate token_t debug_low[MAX_DEBUG_STACK], debug_high[MAX_DEBUG_STACK];
3997c478bd9Sstevel@tonic-gate int debug_prev_level[MAX_DEBUG_STACK];
4007c478bd9Sstevel@tonic-gate int debug_curr_level[MAX_DEBUG_STACK];
4017c478bd9Sstevel@tonic-gate int ndebug_stack = 0;
4027c478bd9Sstevel@tonic-gate
4037c478bd9Sstevel@tonic-gate void
debug_set_level(fcode_env_t * env,int level)4047c478bd9Sstevel@tonic-gate debug_set_level(fcode_env_t *env, int level)
4057c478bd9Sstevel@tonic-gate {
4067c478bd9Sstevel@tonic-gate debug_curr_level[ndebug_stack - 1] = level;
4077c478bd9Sstevel@tonic-gate set_interpreter_debug_level(level);
4087c478bd9Sstevel@tonic-gate }
4097c478bd9Sstevel@tonic-gate
4107c478bd9Sstevel@tonic-gate token_t
find_semi_in_colon_def(fcode_env_t * env,acf_t acf)4117c478bd9Sstevel@tonic-gate find_semi_in_colon_def(fcode_env_t *env, acf_t acf)
4127c478bd9Sstevel@tonic-gate {
4137c478bd9Sstevel@tonic-gate for (; within_dictionary(env, acf); acf++)
4147c478bd9Sstevel@tonic-gate if (*acf == (token_t)(&semi_ptr))
4157c478bd9Sstevel@tonic-gate return ((token_t)acf);
4167c478bd9Sstevel@tonic-gate return (0);
4177c478bd9Sstevel@tonic-gate }
4187c478bd9Sstevel@tonic-gate
4197c478bd9Sstevel@tonic-gate void
check_for_debug_entry(fcode_env_t * env)4207c478bd9Sstevel@tonic-gate check_for_debug_entry(fcode_env_t *env)
4217c478bd9Sstevel@tonic-gate {
4227c478bd9Sstevel@tonic-gate int top;
4237c478bd9Sstevel@tonic-gate
4247c478bd9Sstevel@tonic-gate if (is_debug_word(env, WA) && ndebug_stack < MAX_DEBUG_STACK) {
4257c478bd9Sstevel@tonic-gate top = ndebug_stack++;
4267c478bd9Sstevel@tonic-gate debug_prev_level[top] = get_interpreter_debug_level();
4277c478bd9Sstevel@tonic-gate debug_low[top] = (token_t)WA;
4287c478bd9Sstevel@tonic-gate if (*WA == (token_t)(&do_colon)) {
4297c478bd9Sstevel@tonic-gate debug_high[top] =
4307c478bd9Sstevel@tonic-gate find_semi_in_colon_def(env, WA);
4317c478bd9Sstevel@tonic-gate } else {
4327c478bd9Sstevel@tonic-gate debug_high[top] = 0; /* marker... */
4337c478bd9Sstevel@tonic-gate }
4347c478bd9Sstevel@tonic-gate debug_set_level(env, DEBUG_STEPPING);
4357c478bd9Sstevel@tonic-gate output_step_message(env);
4367c478bd9Sstevel@tonic-gate }
4377c478bd9Sstevel@tonic-gate }
4387c478bd9Sstevel@tonic-gate
4397c478bd9Sstevel@tonic-gate void
check_for_debug_exit(fcode_env_t * env)4407c478bd9Sstevel@tonic-gate check_for_debug_exit(fcode_env_t *env)
4417c478bd9Sstevel@tonic-gate {
4427c478bd9Sstevel@tonic-gate if (ndebug_stack) {
4437c478bd9Sstevel@tonic-gate int top = ndebug_stack - 1;
4447c478bd9Sstevel@tonic-gate
4457c478bd9Sstevel@tonic-gate if (debug_high[top] == 0) {
4467c478bd9Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[top]);
4477c478bd9Sstevel@tonic-gate ndebug_stack--;
4487c478bd9Sstevel@tonic-gate } else if ((token_t)IP >= debug_low[top] &&
4497c478bd9Sstevel@tonic-gate (token_t)IP <= debug_high[top]) {
4507c478bd9Sstevel@tonic-gate set_interpreter_debug_level(debug_curr_level[top]);
4517c478bd9Sstevel@tonic-gate } else {
4527c478bd9Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[top]);
4537c478bd9Sstevel@tonic-gate }
4547c478bd9Sstevel@tonic-gate }
4557c478bd9Sstevel@tonic-gate }
4567c478bd9Sstevel@tonic-gate
4577c478bd9Sstevel@tonic-gate void
check_semi_debug_exit(fcode_env_t * env)4587c478bd9Sstevel@tonic-gate check_semi_debug_exit(fcode_env_t *env)
4597c478bd9Sstevel@tonic-gate {
4607c478bd9Sstevel@tonic-gate if (ndebug_stack) {
4617c478bd9Sstevel@tonic-gate int top = ndebug_stack - 1;
4627c478bd9Sstevel@tonic-gate
4637c478bd9Sstevel@tonic-gate if ((token_t)(IP - 1) == debug_high[top]) {
4647c478bd9Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[top]);
4657c478bd9Sstevel@tonic-gate ndebug_stack--;
4667c478bd9Sstevel@tonic-gate }
4677c478bd9Sstevel@tonic-gate }
4687c478bd9Sstevel@tonic-gate }
4697c478bd9Sstevel@tonic-gate
4707c478bd9Sstevel@tonic-gate /*
4717c478bd9Sstevel@tonic-gate * Really entering do_run, since this may be a recursive entry to do_run,
4727c478bd9Sstevel@tonic-gate * we need to set the debug level to what it was previously.
4737c478bd9Sstevel@tonic-gate */
4747c478bd9Sstevel@tonic-gate int
current_debug_state(fcode_env_t * env)4757c478bd9Sstevel@tonic-gate current_debug_state(fcode_env_t *env)
4767c478bd9Sstevel@tonic-gate {
4777c478bd9Sstevel@tonic-gate if (ndebug_stack) {
4787c478bd9Sstevel@tonic-gate int top = ndebug_stack - 1;
4797c478bd9Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[top]);
4807c478bd9Sstevel@tonic-gate }
4817c478bd9Sstevel@tonic-gate return (ndebug_stack);
4827c478bd9Sstevel@tonic-gate }
4837c478bd9Sstevel@tonic-gate
4847c478bd9Sstevel@tonic-gate void
clear_debug_state(fcode_env_t * env,int oldstate)4857c478bd9Sstevel@tonic-gate clear_debug_state(fcode_env_t *env, int oldstate)
4867c478bd9Sstevel@tonic-gate {
4877c478bd9Sstevel@tonic-gate if (ndebug_stack && oldstate <= ndebug_stack) {
4887c478bd9Sstevel@tonic-gate set_interpreter_debug_level(debug_prev_level[oldstate]);
4897c478bd9Sstevel@tonic-gate ndebug_stack = oldstate;
4907c478bd9Sstevel@tonic-gate }
4917c478bd9Sstevel@tonic-gate }
4927c478bd9Sstevel@tonic-gate
4937c478bd9Sstevel@tonic-gate void
unbug(fcode_env_t * env)4947c478bd9Sstevel@tonic-gate unbug(fcode_env_t *env)
4957c478bd9Sstevel@tonic-gate {
4967c478bd9Sstevel@tonic-gate int i;
4977c478bd9Sstevel@tonic-gate token_t *link;
4987c478bd9Sstevel@tonic-gate flag_t *flag;
4997c478bd9Sstevel@tonic-gate
5007c478bd9Sstevel@tonic-gate for (i = ndebug_stack - 1; i >= 0; i--) {
5017c478bd9Sstevel@tonic-gate link = ACF_TO_LINK(debug_low[i]);
5027c478bd9Sstevel@tonic-gate flag = LINK_TO_FLAGS(link);
5037c478bd9Sstevel@tonic-gate *flag &= ~FLAG_DEBUG;
5047c478bd9Sstevel@tonic-gate }
5057c478bd9Sstevel@tonic-gate clear_debug_state(env, 0);
5067c478bd9Sstevel@tonic-gate }
5077c478bd9Sstevel@tonic-gate
5087c478bd9Sstevel@tonic-gate void
output_vitals(fcode_env_t * env)5097c478bd9Sstevel@tonic-gate output_vitals(fcode_env_t *env)
5107c478bd9Sstevel@tonic-gate {
5117c478bd9Sstevel@tonic-gate log_message(MSG_FC_DEBUG, "IP=%p, *IP=%p, WA=%p, *WA=%p ", IP,
5127c478bd9Sstevel@tonic-gate (IP ? *IP : 0), WA, (WA ? *WA : 0));
5137c478bd9Sstevel@tonic-gate }
5147c478bd9Sstevel@tonic-gate
5157c478bd9Sstevel@tonic-gate int
do_exec_debug(fcode_env_t * env,void * fn)5167c478bd9Sstevel@tonic-gate do_exec_debug(fcode_env_t *env, void *fn)
5177c478bd9Sstevel@tonic-gate {
5187c478bd9Sstevel@tonic-gate int dl = debug_level;
5197c478bd9Sstevel@tonic-gate int show_wa = 1;
5207c478bd9Sstevel@tonic-gate
5217c478bd9Sstevel@tonic-gate if ((dl & (DEBUG_EXEC_DUMP_DS | DEBUG_EXEC_DUMP_RS |
5227c478bd9Sstevel@tonic-gate DEBUG_EXEC_SHOW_VITALS | DEBUG_EXEC_TRACE | DEBUG_TRACING |
5237c478bd9Sstevel@tonic-gate DEBUG_STEPPING)) == 0)
5247c478bd9Sstevel@tonic-gate return (0);
5257c478bd9Sstevel@tonic-gate
5267c478bd9Sstevel@tonic-gate if (dl & DEBUG_STEPPING) {
5277c478bd9Sstevel@tonic-gate dl |= DEBUG_EXEC_DUMP_DS;
5287c478bd9Sstevel@tonic-gate }
5297c478bd9Sstevel@tonic-gate if (dl & (DEBUG_STEPPING | DEBUG_EXEC_TRACE)) {
5307c478bd9Sstevel@tonic-gate log_message(MSG_FC_DEBUG, "%-15s ", acf_to_name(env, WA));
5317c478bd9Sstevel@tonic-gate show_wa = 0;
5327c478bd9Sstevel@tonic-gate }
5337c478bd9Sstevel@tonic-gate if (dl & DEBUG_EXEC_DUMP_DS)
5347c478bd9Sstevel@tonic-gate output_data_stack(env, MSG_FC_DEBUG);
5357c478bd9Sstevel@tonic-gate if (dl & DEBUG_EXEC_DUMP_RS)
5367c478bd9Sstevel@tonic-gate output_return_stack(env, show_wa, MSG_FC_DEBUG);
5377c478bd9Sstevel@tonic-gate if (dl & DEBUG_EXEC_SHOW_VITALS)
5387c478bd9Sstevel@tonic-gate output_vitals(env);
5397c478bd9Sstevel@tonic-gate if (dl & DEBUG_TRACING)
5407c478bd9Sstevel@tonic-gate do_fclib_trace(env, (void *) fn);
5417c478bd9Sstevel@tonic-gate log_message(MSG_FC_DEBUG, "\n");
5427c478bd9Sstevel@tonic-gate if (dl & DEBUG_STEPPING)
5437c478bd9Sstevel@tonic-gate return (do_fclib_step(env));
5447c478bd9Sstevel@tonic-gate return (0);
5457c478bd9Sstevel@tonic-gate }
5467c478bd9Sstevel@tonic-gate
5477c478bd9Sstevel@tonic-gate static void
smatch(fcode_env_t * env)5487c478bd9Sstevel@tonic-gate smatch(fcode_env_t *env)
5497c478bd9Sstevel@tonic-gate {
5507c478bd9Sstevel@tonic-gate int len;
5517c478bd9Sstevel@tonic-gate char *str, *p;
5527c478bd9Sstevel@tonic-gate
5537c478bd9Sstevel@tonic-gate if ((str = parse_a_string(env, &len)) == NULL)
5547c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "smatch: no string\n");
5557c478bd9Sstevel@tonic-gate else {
5567c478bd9Sstevel@tonic-gate for (p = (char *)env->base; p < (char *)HERE; p++)
5577c478bd9Sstevel@tonic-gate if (memcmp(p, str, len) == 0)
5587c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "%p\n", p);
5597c478bd9Sstevel@tonic-gate }
5607c478bd9Sstevel@tonic-gate }
5617c478bd9Sstevel@tonic-gate
5627c478bd9Sstevel@tonic-gate void
check_vitals(fcode_env_t * env)5637c478bd9Sstevel@tonic-gate check_vitals(fcode_env_t *env)
5647c478bd9Sstevel@tonic-gate {
5657c478bd9Sstevel@tonic-gate int i;
5667c478bd9Sstevel@tonic-gate token_t *dptr;
5677c478bd9Sstevel@tonic-gate
5687c478bd9Sstevel@tonic-gate dptr = env->current;
5697c478bd9Sstevel@tonic-gate if (*dptr && !within_dictionary(env, (uchar_t *)*dptr))
5707c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "Current: %p outside dictionary\n",
5717c478bd9Sstevel@tonic-gate *dptr);
5727c478bd9Sstevel@tonic-gate for (i = env->order_depth; i >= 0; i--) {
5737c478bd9Sstevel@tonic-gate dptr = env->order[i];
5747c478bd9Sstevel@tonic-gate if (!dptr)
5757c478bd9Sstevel@tonic-gate continue;
5767c478bd9Sstevel@tonic-gate if (*dptr && !within_dictionary(env, (uchar_t *)*dptr))
5777c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "Order%d: %p outside"
5787c478bd9Sstevel@tonic-gate " dictionary\n", i, *dptr);
5797c478bd9Sstevel@tonic-gate }
5807c478bd9Sstevel@tonic-gate if (HERE < env->base || HERE >= env->base + dict_size) {
5817c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "HERE: %p outside range\n", HERE);
5827c478bd9Sstevel@tonic-gate }
5837c478bd9Sstevel@tonic-gate if (DS < env->ds0 || DS >= &env->ds0[stack_size]) {
5847c478bd9Sstevel@tonic-gate forth_abort(env, "DS: %p outside range\n", DS);
5857c478bd9Sstevel@tonic-gate }
5867c478bd9Sstevel@tonic-gate if (RS < env->rs0 || RS >= &env->rs0[stack_size]) {
5877c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "RS: %p outside range\n", RS);
5887c478bd9Sstevel@tonic-gate RS = env->rs0;
5897c478bd9Sstevel@tonic-gate }
5907c478bd9Sstevel@tonic-gate if (IP && !within_dictionary(env, IP))
5917c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "IP: %p outside dictionary\n", IP);
5927c478bd9Sstevel@tonic-gate if (!within_dictionary(env, (void *)env->forth_voc_link))
5937c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "forth_voc_link: %p outside"
5947c478bd9Sstevel@tonic-gate " dictionary\n", env->forth_voc_link);
5957c478bd9Sstevel@tonic-gate }
5967c478bd9Sstevel@tonic-gate
5977c478bd9Sstevel@tonic-gate static void
dump_table(fcode_env_t * env)5987c478bd9Sstevel@tonic-gate dump_table(fcode_env_t *env)
5997c478bd9Sstevel@tonic-gate {
6007c478bd9Sstevel@tonic-gate int i;
6017c478bd9Sstevel@tonic-gate
6027c478bd9Sstevel@tonic-gate for (i = 0; i < MAX_FCODE; i++) {
6037c478bd9Sstevel@tonic-gate if (*(env->table[i].apf) != (token_t)(&f_error)) {
6047c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "Token: %4x %32s acf = %8p,"
6057c478bd9Sstevel@tonic-gate " %8p\n", i, env->table[i].name, env->table[i].apf,
6067c478bd9Sstevel@tonic-gate *(env->table[i].apf));
6077c478bd9Sstevel@tonic-gate }
6087c478bd9Sstevel@tonic-gate }
6097c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "%d FCODES implemented\n", fcode_impl_count);
6107c478bd9Sstevel@tonic-gate }
6117c478bd9Sstevel@tonic-gate
6127c478bd9Sstevel@tonic-gate void
verify_usage(fcode_env_t * env)6137c478bd9Sstevel@tonic-gate verify_usage(fcode_env_t *env)
6147c478bd9Sstevel@tonic-gate {
6157c478bd9Sstevel@tonic-gate int i, untested = 0;
6167c478bd9Sstevel@tonic-gate
6177c478bd9Sstevel@tonic-gate for (i = 0; i < MAX_FCODE; i++) {
6187c478bd9Sstevel@tonic-gate int verify;
6197c478bd9Sstevel@tonic-gate
6207c478bd9Sstevel@tonic-gate verify = env->table[i].flags & (ANSI_WORD|P1275_WORD);
6217c478bd9Sstevel@tonic-gate if ((verify) &&
6227c478bd9Sstevel@tonic-gate #ifdef DEBUG
623*09e6639bSToomas Soome (env->table[i].usage == 0) &&
6247c478bd9Sstevel@tonic-gate #endif
625*09e6639bSToomas Soome (env->table[i].apf)) {
6267c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG,
6277c478bd9Sstevel@tonic-gate "Untested: %4x %32s acf = %8p, %8p\n", i,
6287c478bd9Sstevel@tonic-gate env->table[i].name, env->table[i].apf,
6297c478bd9Sstevel@tonic-gate *(env->table[i].apf));
6307c478bd9Sstevel@tonic-gate untested++;
6317c478bd9Sstevel@tonic-gate }
6327c478bd9Sstevel@tonic-gate }
6337c478bd9Sstevel@tonic-gate if (untested)
6347c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "%d untested tokens\n", untested);
6357c478bd9Sstevel@tonic-gate }
6367c478bd9Sstevel@tonic-gate
6377c478bd9Sstevel@tonic-gate static void
debugf(fcode_env_t * env)6387c478bd9Sstevel@tonic-gate debugf(fcode_env_t *env)
6397c478bd9Sstevel@tonic-gate {
6407c478bd9Sstevel@tonic-gate PUSH(DS, (fstack_t)&debug_level);
6417c478bd9Sstevel@tonic-gate }
6427c478bd9Sstevel@tonic-gate
6437c478bd9Sstevel@tonic-gate static void
control(fcode_env_t * env)6447c478bd9Sstevel@tonic-gate control(fcode_env_t *env)
6457c478bd9Sstevel@tonic-gate {
6467c478bd9Sstevel@tonic-gate PUSH(DS, (fstack_t)&env->control);
6477c478bd9Sstevel@tonic-gate }
6487c478bd9Sstevel@tonic-gate
6497c478bd9Sstevel@tonic-gate struct bittab {
6507c478bd9Sstevel@tonic-gate int b_bitval;
6517c478bd9Sstevel@tonic-gate char *b_bitname;
6527c478bd9Sstevel@tonic-gate } bittab[] = {
6537c478bd9Sstevel@tonic-gate DEBUG_CONTEXT, "context",
6547c478bd9Sstevel@tonic-gate DEBUG_BYTELOAD_DS, "byteload-ds",
6557c478bd9Sstevel@tonic-gate DEBUG_BYTELOAD_RS, "byteload-rs",
6567c478bd9Sstevel@tonic-gate DEBUG_BYTELOAD_TOKENS, "byteload-tokens",
6577c478bd9Sstevel@tonic-gate DEBUG_NEW_TOKEN, "new-token",
6587c478bd9Sstevel@tonic-gate DEBUG_EXEC_TRACE, "exec-trace",
6597c478bd9Sstevel@tonic-gate DEBUG_EXEC_SHOW_VITALS, "exec-show-vitals",
6607c478bd9Sstevel@tonic-gate DEBUG_EXEC_DUMP_DS, "exec-dump-ds",
6617c478bd9Sstevel@tonic-gate DEBUG_EXEC_DUMP_RS, "exec-dump-rs",
6627c478bd9Sstevel@tonic-gate DEBUG_COMMA, "comma",
6637c478bd9Sstevel@tonic-gate DEBUG_HEADER, "header",
6647c478bd9Sstevel@tonic-gate DEBUG_EXIT_WORDS, "exit-words",
6657c478bd9Sstevel@tonic-gate DEBUG_EXIT_DUMP, "exit-dump",
6667c478bd9Sstevel@tonic-gate DEBUG_DUMP_TOKENS, "dump-tokens",
6677c478bd9Sstevel@tonic-gate DEBUG_COLON, "colon",
6687c478bd9Sstevel@tonic-gate DEBUG_NEXT_VITALS, "next-vitals",
6697c478bd9Sstevel@tonic-gate DEBUG_VOC_FIND, "voc-find",
6707c478bd9Sstevel@tonic-gate DEBUG_DUMP_DICT_TOKENS, "dump-dict-tokens",
6717c478bd9Sstevel@tonic-gate DEBUG_TOKEN_USAGE, "token-usage",
6727c478bd9Sstevel@tonic-gate DEBUG_DUMP_TOKEN_TABLE, "dump-token-table",
6737c478bd9Sstevel@tonic-gate DEBUG_SHOW_STACK, "show-stack",
6747c478bd9Sstevel@tonic-gate DEBUG_SHOW_RS, "show-rs",
6757c478bd9Sstevel@tonic-gate DEBUG_TRACING, "tracing",
6767c478bd9Sstevel@tonic-gate DEBUG_TRACE_STACK, "trace-stack",
6777c478bd9Sstevel@tonic-gate DEBUG_CALL_METHOD, "call-method",
6787c478bd9Sstevel@tonic-gate DEBUG_ACTIONS, "actions",
6797c478bd9Sstevel@tonic-gate DEBUG_STEPPING, "stepping",
6807c478bd9Sstevel@tonic-gate DEBUG_REG_ACCESS, "reg-access",
6817c478bd9Sstevel@tonic-gate DEBUG_ADDR_ABUSE, "addr-abuse",
6827c478bd9Sstevel@tonic-gate DEBUG_FIND_FCODE, "find-fcode",
6837c478bd9Sstevel@tonic-gate DEBUG_UPLOAD, "upload",
6847c478bd9Sstevel@tonic-gate 0
6857c478bd9Sstevel@tonic-gate };
6867c478bd9Sstevel@tonic-gate
6877c478bd9Sstevel@tonic-gate void
debug_flags_to_output(fcode_env_t * env,int flags)6887c478bd9Sstevel@tonic-gate debug_flags_to_output(fcode_env_t *env, int flags)
6897c478bd9Sstevel@tonic-gate {
6907c478bd9Sstevel@tonic-gate int first = 1, i;
6917c478bd9Sstevel@tonic-gate
6927c478bd9Sstevel@tonic-gate for (i = 0; bittab[i].b_bitval != 0; i++)
6937c478bd9Sstevel@tonic-gate if (bittab[i].b_bitval & flags) {
6947c478bd9Sstevel@tonic-gate if (!first)
6957c478bd9Sstevel@tonic-gate log_message(MSG_INFO, ",");
6967c478bd9Sstevel@tonic-gate first = 0;
6977c478bd9Sstevel@tonic-gate log_message(MSG_INFO, bittab[i].b_bitname);
6987c478bd9Sstevel@tonic-gate }
6997c478bd9Sstevel@tonic-gate if (first)
7007c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "<empty>");
7017c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "\n");
7027c478bd9Sstevel@tonic-gate }
7037c478bd9Sstevel@tonic-gate
7047c478bd9Sstevel@tonic-gate static void
dot_debugf(fcode_env_t * env)7057c478bd9Sstevel@tonic-gate dot_debugf(fcode_env_t *env)
7067c478bd9Sstevel@tonic-gate {
7077c478bd9Sstevel@tonic-gate debug_flags_to_output(env, debug_level);
7087c478bd9Sstevel@tonic-gate }
7097c478bd9Sstevel@tonic-gate
7107c478bd9Sstevel@tonic-gate static void
debugf_qmark(fcode_env_t * env)7117c478bd9Sstevel@tonic-gate debugf_qmark(fcode_env_t *env)
7127c478bd9Sstevel@tonic-gate {
7137c478bd9Sstevel@tonic-gate debug_flags_to_output(env, 0xffffffff);
7147c478bd9Sstevel@tonic-gate }
7157c478bd9Sstevel@tonic-gate
7167c478bd9Sstevel@tonic-gate int
debug_flags_to_mask(char * str)7177c478bd9Sstevel@tonic-gate debug_flags_to_mask(char *str)
7187c478bd9Sstevel@tonic-gate {
7197c478bd9Sstevel@tonic-gate int flags = 0;
7207c478bd9Sstevel@tonic-gate char *p;
7217c478bd9Sstevel@tonic-gate int i;
7227c478bd9Sstevel@tonic-gate
7237c478bd9Sstevel@tonic-gate if (isdigit(*str)) {
7247c478bd9Sstevel@tonic-gate if (*str == '0') {
7257c478bd9Sstevel@tonic-gate str++;
7267c478bd9Sstevel@tonic-gate if (*str == 'x' || *str == 'X') {
727*09e6639bSToomas Soome (void) sscanf(str + 1, "%x", &flags);
7287c478bd9Sstevel@tonic-gate } else
729*09e6639bSToomas Soome (void) sscanf(str, "%o", &flags);
7307c478bd9Sstevel@tonic-gate } else
731*09e6639bSToomas Soome (void) sscanf(str, "%d", &flags);
7327c478bd9Sstevel@tonic-gate return (flags);
7337c478bd9Sstevel@tonic-gate }
7347c478bd9Sstevel@tonic-gate if (strcmp(str, "clear") == 0)
7357c478bd9Sstevel@tonic-gate return (0);
7367c478bd9Sstevel@tonic-gate if (strcmp(str, "all") == 0)
7377c478bd9Sstevel@tonic-gate return (0xffffffff & ~DEBUG_STEPPING);
7387c478bd9Sstevel@tonic-gate if (*str) {
7397c478bd9Sstevel@tonic-gate do {
7407c478bd9Sstevel@tonic-gate if (p = strchr(str, ','))
7417c478bd9Sstevel@tonic-gate *p++ = '\0';
7427c478bd9Sstevel@tonic-gate for (i = 0; bittab[i].b_bitname != 0; i++)
7437c478bd9Sstevel@tonic-gate if (strcmp(str, bittab[i].b_bitname) == 0) {
7447c478bd9Sstevel@tonic-gate flags |= bittab[i].b_bitval;
7457c478bd9Sstevel@tonic-gate break;
7467c478bd9Sstevel@tonic-gate }
7477c478bd9Sstevel@tonic-gate if (bittab[i].b_bitname == 0)
7487c478bd9Sstevel@tonic-gate log_message(MSG_WARN,
7497c478bd9Sstevel@tonic-gate "Unknown debug flag: '%s'\n", str);
7507c478bd9Sstevel@tonic-gate str = p;
7517c478bd9Sstevel@tonic-gate } while (p);
7527c478bd9Sstevel@tonic-gate }
7537c478bd9Sstevel@tonic-gate return (flags);
7547c478bd9Sstevel@tonic-gate }
7557c478bd9Sstevel@tonic-gate
7567c478bd9Sstevel@tonic-gate static void
set_debugf(fcode_env_t * env)7577c478bd9Sstevel@tonic-gate set_debugf(fcode_env_t *env)
7587c478bd9Sstevel@tonic-gate {
7597c478bd9Sstevel@tonic-gate char *str;
7607c478bd9Sstevel@tonic-gate
7617c478bd9Sstevel@tonic-gate str = parse_a_string(env, NULL);
7627c478bd9Sstevel@tonic-gate debug_level = debug_flags_to_mask(str);
7637c478bd9Sstevel@tonic-gate }
7647c478bd9Sstevel@tonic-gate
7657c478bd9Sstevel@tonic-gate static acf_t
show_a_word(fcode_env_t * env,acf_t acf,void * arg)7667c478bd9Sstevel@tonic-gate show_a_word(fcode_env_t *env, acf_t acf, void *arg)
7677c478bd9Sstevel@tonic-gate {
7687c478bd9Sstevel@tonic-gate static int nshow_words = 0;
7697c478bd9Sstevel@tonic-gate
7707c478bd9Sstevel@tonic-gate if (acf == NULL) {
7717c478bd9Sstevel@tonic-gate if (nshow_words > 0) {
7727c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "\n");
7737c478bd9Sstevel@tonic-gate nshow_words = 0;
7747c478bd9Sstevel@tonic-gate }
7757c478bd9Sstevel@tonic-gate return (NULL);
7767c478bd9Sstevel@tonic-gate }
7777c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "%15s ", get_name_or_acf(ACF_TO_LINK(acf)));
7787c478bd9Sstevel@tonic-gate nshow_words++;
7797c478bd9Sstevel@tonic-gate if (nshow_words >= 4) {
7807c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "\n");
7817c478bd9Sstevel@tonic-gate nshow_words = 0;
7827c478bd9Sstevel@tonic-gate }
7837c478bd9Sstevel@tonic-gate return (NULL);
7847c478bd9Sstevel@tonic-gate }
7857c478bd9Sstevel@tonic-gate
7867c478bd9Sstevel@tonic-gate void
words(fcode_env_t * env)7877c478bd9Sstevel@tonic-gate words(fcode_env_t *env)
7887c478bd9Sstevel@tonic-gate {
7897c478bd9Sstevel@tonic-gate (void) search_all_dictionaries(env, show_a_word, NULL);
7907c478bd9Sstevel@tonic-gate (void) show_a_word(env, NULL, NULL);
7917c478bd9Sstevel@tonic-gate }
7927c478bd9Sstevel@tonic-gate
7937c478bd9Sstevel@tonic-gate static acf_t
dump_a_word(fcode_env_t * env,acf_t acf,void * arg)7947c478bd9Sstevel@tonic-gate dump_a_word(fcode_env_t *env, acf_t acf, void *arg)
7957c478bd9Sstevel@tonic-gate {
7967c478bd9Sstevel@tonic-gate output_acf_name(acf);
7977c478bd9Sstevel@tonic-gate return (NULL);
7987c478bd9Sstevel@tonic-gate }
7997c478bd9Sstevel@tonic-gate
8007c478bd9Sstevel@tonic-gate void
dump_words(fcode_env_t * env)8017c478bd9Sstevel@tonic-gate dump_words(fcode_env_t *env)
8027c478bd9Sstevel@tonic-gate {
8037c478bd9Sstevel@tonic-gate (void) search_all_dictionaries(env, dump_a_word, NULL);
8047c478bd9Sstevel@tonic-gate output_acf_name(NULL);
8057c478bd9Sstevel@tonic-gate }
8067c478bd9Sstevel@tonic-gate
8077c478bd9Sstevel@tonic-gate static void
dump_line(uchar_t * ptr)8087c478bd9Sstevel@tonic-gate dump_line(uchar_t *ptr)
8097c478bd9Sstevel@tonic-gate {
8107c478bd9Sstevel@tonic-gate uchar_t *byte;
8117c478bd9Sstevel@tonic-gate int i;
8127c478bd9Sstevel@tonic-gate
813360e6f5eSmathue log_message(MSG_INFO, "%p ", ptr);
8147c478bd9Sstevel@tonic-gate for (i = 0, byte = ptr; i < 16; i++) {
8157c478bd9Sstevel@tonic-gate if (i == 8)
8167c478bd9Sstevel@tonic-gate log_message(MSG_INFO, " ");
8177c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "%02.2x ", *byte++);
8187c478bd9Sstevel@tonic-gate }
8197c478bd9Sstevel@tonic-gate log_message(MSG_INFO, " ");
8207c478bd9Sstevel@tonic-gate for (i = 0, byte = ptr; i < 16; i++, byte++) {
8217c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "%c",
8227c478bd9Sstevel@tonic-gate ((*byte < 0x20) || (*byte > 0x7f)) ? '.' : *byte);
8237c478bd9Sstevel@tonic-gate }
8247c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "\n");
8257c478bd9Sstevel@tonic-gate }
8267c478bd9Sstevel@tonic-gate
8277c478bd9Sstevel@tonic-gate void
dump_dictionary(fcode_env_t * env)8287c478bd9Sstevel@tonic-gate dump_dictionary(fcode_env_t *env)
8297c478bd9Sstevel@tonic-gate {
8307c478bd9Sstevel@tonic-gate uchar_t *ptr;
8317c478bd9Sstevel@tonic-gate
8327c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "Dictionary dump: base: %p\n", env->base);
8337c478bd9Sstevel@tonic-gate for (ptr = (uchar_t *)(((long)(env->base)) & ~0xf); ptr < HERE;
8347c478bd9Sstevel@tonic-gate ptr += 16)
8357c478bd9Sstevel@tonic-gate dump_line(ptr);
8367c478bd9Sstevel@tonic-gate }
8377c478bd9Sstevel@tonic-gate
8387c478bd9Sstevel@tonic-gate static char *
acf_to_fcode_name(fcode_env_t * env,acf_t acf)8397c478bd9Sstevel@tonic-gate acf_to_fcode_name(fcode_env_t *env, acf_t acf)
8407c478bd9Sstevel@tonic-gate {
8417c478bd9Sstevel@tonic-gate int i;
8427c478bd9Sstevel@tonic-gate
8437c478bd9Sstevel@tonic-gate for (i = 0; i < MAX_FCODE; i++)
8447c478bd9Sstevel@tonic-gate if (env->table[i].apf == acf)
8457c478bd9Sstevel@tonic-gate return (env->table[i].name);
8467c478bd9Sstevel@tonic-gate return (NULL);
8477c478bd9Sstevel@tonic-gate }
8487c478bd9Sstevel@tonic-gate
8497c478bd9Sstevel@tonic-gate static acf_t
acf_match(fcode_env_t * env,acf_t sacf,void * macf)8507c478bd9Sstevel@tonic-gate acf_match(fcode_env_t *env, acf_t sacf, void *macf)
8517c478bd9Sstevel@tonic-gate {
8527c478bd9Sstevel@tonic-gate if (sacf == (acf_t)macf)
8537c478bd9Sstevel@tonic-gate return (sacf);
8547c478bd9Sstevel@tonic-gate return (NULL);
8557c478bd9Sstevel@tonic-gate }
8567c478bd9Sstevel@tonic-gate
8577c478bd9Sstevel@tonic-gate /*
8587c478bd9Sstevel@tonic-gate * Given an ACF, return ptr to name or "unknown" string.
8597c478bd9Sstevel@tonic-gate */
8607c478bd9Sstevel@tonic-gate char *
acf_to_name(fcode_env_t * env,acf_t acf)8617c478bd9Sstevel@tonic-gate acf_to_name(fcode_env_t *env, acf_t acf)
8627c478bd9Sstevel@tonic-gate {
8637c478bd9Sstevel@tonic-gate struct bitab *bip;
8647c478bd9Sstevel@tonic-gate static char name_buf[256];
8657c478bd9Sstevel@tonic-gate uchar_t *p, *np;
8667c478bd9Sstevel@tonic-gate int i, n;
8677c478bd9Sstevel@tonic-gate
8687c478bd9Sstevel@tonic-gate if (!within_dictionary(env, acf)) {
8697c478bd9Sstevel@tonic-gate if ((bip = lookup_builtin((token_t)acf)) != NULL)
8707c478bd9Sstevel@tonic-gate return (bip->bi_name);
8717c478bd9Sstevel@tonic-gate return (NULL);
8727c478bd9Sstevel@tonic-gate }
8737c478bd9Sstevel@tonic-gate return (get_name_or_acf(ACF_TO_LINK(acf)));
8747c478bd9Sstevel@tonic-gate }
8757c478bd9Sstevel@tonic-gate
8767c478bd9Sstevel@tonic-gate int
within_dictionary(fcode_env_t * env,void * addr)8777c478bd9Sstevel@tonic-gate within_dictionary(fcode_env_t *env, void *addr)
8787c478bd9Sstevel@tonic-gate {
8797c478bd9Sstevel@tonic-gate return ((uchar_t *)addr >= env->base &&
8807c478bd9Sstevel@tonic-gate (uchar_t *)addr < env->base + dict_size);
8817c478bd9Sstevel@tonic-gate }
8827c478bd9Sstevel@tonic-gate
8837c478bd9Sstevel@tonic-gate static int
within_word(fcode_env_t * env,acf_t acf,acf_t wacf)8847c478bd9Sstevel@tonic-gate within_word(fcode_env_t *env, acf_t acf, acf_t wacf)
8857c478bd9Sstevel@tonic-gate {
8867c478bd9Sstevel@tonic-gate if (acf == wacf || acf + 1 == wacf)
8877c478bd9Sstevel@tonic-gate return (1);
8887c478bd9Sstevel@tonic-gate if (*acf == (token_t)(&do_colon)) {
8897c478bd9Sstevel@tonic-gate do {
8907c478bd9Sstevel@tonic-gate if (acf == wacf)
8917c478bd9Sstevel@tonic-gate return (1);
8927c478bd9Sstevel@tonic-gate } while (*acf++ != (token_t)(&semi_ptr));
8937c478bd9Sstevel@tonic-gate }
8947c478bd9Sstevel@tonic-gate return (0);
8957c478bd9Sstevel@tonic-gate }
8967c478bd9Sstevel@tonic-gate
8977c478bd9Sstevel@tonic-gate /*
8987c478bd9Sstevel@tonic-gate * Given an ACF in the middle of a colon definition, search dictionary towards
8997c478bd9Sstevel@tonic-gate * beginning for "colon" acf. If we find a "semi" acf first, we're not in
9007c478bd9Sstevel@tonic-gate * the middle of a colon-def (temporary execute?).
9017c478bd9Sstevel@tonic-gate */
9027c478bd9Sstevel@tonic-gate char *
acf_backup_search(fcode_env_t * env,acf_t acf)9037c478bd9Sstevel@tonic-gate acf_backup_search(fcode_env_t *env, acf_t acf)
9047c478bd9Sstevel@tonic-gate {
9057c478bd9Sstevel@tonic-gate acf_t nacf;
9067c478bd9Sstevel@tonic-gate char *name;
9077c478bd9Sstevel@tonic-gate
9087c478bd9Sstevel@tonic-gate if ((acf_t)_ALIGN(acf, token_t) == acf && within_dictionary(env, acf)) {
9097c478bd9Sstevel@tonic-gate for (nacf = acf; nacf >= (acf_t)env->base; nacf--)
9107c478bd9Sstevel@tonic-gate if (*nacf == (token_t)(&do_colon) ||
9117c478bd9Sstevel@tonic-gate *nacf == (token_t)(&semi_ptr))
9127c478bd9Sstevel@tonic-gate break;
9137c478bd9Sstevel@tonic-gate if (nacf >= (acf_t)env->base && *nacf == (token_t)(&do_colon) &&
9147c478bd9Sstevel@tonic-gate (name = get_name(ACF_TO_LINK(nacf))) != NULL)
9157c478bd9Sstevel@tonic-gate return (name);
9167c478bd9Sstevel@tonic-gate }
9177c478bd9Sstevel@tonic-gate return (acf_to_str(acf));
9187c478bd9Sstevel@tonic-gate }
9197c478bd9Sstevel@tonic-gate
9207c478bd9Sstevel@tonic-gate /*
9217c478bd9Sstevel@tonic-gate * Print out current process's C stack using /usr/proc/bin/pstack
9227c478bd9Sstevel@tonic-gate */
9237c478bd9Sstevel@tonic-gate void
ctrace(fcode_env_t * env)9247c478bd9Sstevel@tonic-gate ctrace(fcode_env_t *env)
9257c478bd9Sstevel@tonic-gate {
9267c478bd9Sstevel@tonic-gate char buf[256];
9277c478bd9Sstevel@tonic-gate FILE *fd;
9287c478bd9Sstevel@tonic-gate
9297c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "Interpreter C Stack:\n");
930*09e6639bSToomas Soome (void) sprintf(buf, "/usr/proc/bin/pstack %d", getpid());
9317c478bd9Sstevel@tonic-gate if ((fd = popen(buf, "r")) == NULL)
9327c478bd9Sstevel@tonic-gate log_perror(MSG_ERROR, "Can't run: %s", buf);
9337c478bd9Sstevel@tonic-gate else {
9347c478bd9Sstevel@tonic-gate while (fgets(buf, sizeof (buf), fd))
9357c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, buf);
936*09e6639bSToomas Soome (void) fclose(fd);
9377c478bd9Sstevel@tonic-gate }
9387c478bd9Sstevel@tonic-gate }
9397c478bd9Sstevel@tonic-gate
9407c478bd9Sstevel@tonic-gate /*
9417c478bd9Sstevel@tonic-gate * Dump data, return stacks, try to unthread forth calling stack.
9427c478bd9Sstevel@tonic-gate */
9437c478bd9Sstevel@tonic-gate void
ftrace(fcode_env_t * env)9447c478bd9Sstevel@tonic-gate ftrace(fcode_env_t *env)
9457c478bd9Sstevel@tonic-gate {
9467c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "Forth Interpreter Stacks:\n");
9477c478bd9Sstevel@tonic-gate output_data_stack(env, MSG_DEBUG);
9487c478bd9Sstevel@tonic-gate output_return_stack(env, 1, MSG_DEBUG);
9497c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "\n");
9507c478bd9Sstevel@tonic-gate }
9517c478bd9Sstevel@tonic-gate
9527c478bd9Sstevel@tonic-gate int in_forth_abort;
9537c478bd9Sstevel@tonic-gate
9547c478bd9Sstevel@tonic-gate /*
9557c478bd9Sstevel@tonic-gate * Handle fatal error, if interactive mode, return to ok prompt.
9567c478bd9Sstevel@tonic-gate */
9577c478bd9Sstevel@tonic-gate void
forth_abort(fcode_env_t * env,char * fmt,...)9587c478bd9Sstevel@tonic-gate forth_abort(fcode_env_t *env, char *fmt, ...)
9597c478bd9Sstevel@tonic-gate {
9607c478bd9Sstevel@tonic-gate va_list ap;
9617c478bd9Sstevel@tonic-gate char msg[256];
9627c478bd9Sstevel@tonic-gate
9637c478bd9Sstevel@tonic-gate if (in_forth_abort) {
9647c478bd9Sstevel@tonic-gate log_message(MSG_FATAL, "ABORT: abort within forth_abort\n");
9657c478bd9Sstevel@tonic-gate abort();
9667c478bd9Sstevel@tonic-gate }
9677c478bd9Sstevel@tonic-gate in_forth_abort++;
9687c478bd9Sstevel@tonic-gate
9697c478bd9Sstevel@tonic-gate va_start(ap, fmt);
970*09e6639bSToomas Soome (void) vsprintf(msg, fmt, ap);
9717c478bd9Sstevel@tonic-gate log_message(MSG_ERROR, "ABORT: %s\n", msg);
9727c478bd9Sstevel@tonic-gate
9737c478bd9Sstevel@tonic-gate if (env) {
9747c478bd9Sstevel@tonic-gate ctrace(env);
9757c478bd9Sstevel@tonic-gate ftrace(env);
9767c478bd9Sstevel@tonic-gate }
9777c478bd9Sstevel@tonic-gate
9787c478bd9Sstevel@tonic-gate return_to_interact(env);
9797c478bd9Sstevel@tonic-gate /*
9807c478bd9Sstevel@tonic-gate * If not in interactive mode, return_to_interact just returns.
9817c478bd9Sstevel@tonic-gate */
9827c478bd9Sstevel@tonic-gate exit(1);
9837c478bd9Sstevel@tonic-gate }
9847c478bd9Sstevel@tonic-gate
9857c478bd9Sstevel@tonic-gate /*
9867c478bd9Sstevel@tonic-gate * Handle fatal system call error
9877c478bd9Sstevel@tonic-gate */
9887c478bd9Sstevel@tonic-gate void
forth_perror(fcode_env_t * env,char * fmt,...)9897c478bd9Sstevel@tonic-gate forth_perror(fcode_env_t *env, char *fmt, ...)
9907c478bd9Sstevel@tonic-gate {
9917c478bd9Sstevel@tonic-gate va_list ap;
9927c478bd9Sstevel@tonic-gate char msg[256];
9937c478bd9Sstevel@tonic-gate int save_errno = errno; /* just in case... */
9947c478bd9Sstevel@tonic-gate
9957c478bd9Sstevel@tonic-gate va_start(ap, fmt);
996*09e6639bSToomas Soome (void) vsprintf(msg, fmt, ap);
9977c478bd9Sstevel@tonic-gate
9987c478bd9Sstevel@tonic-gate forth_abort(env, "%s: %s", msg, strerror(save_errno));
9997c478bd9Sstevel@tonic-gate }
10007c478bd9Sstevel@tonic-gate
10017c478bd9Sstevel@tonic-gate static void
show_stack(fcode_env_t * env)10027c478bd9Sstevel@tonic-gate show_stack(fcode_env_t *env)
10037c478bd9Sstevel@tonic-gate {
10047c478bd9Sstevel@tonic-gate #ifdef DEBUG
10057c478bd9Sstevel@tonic-gate debug_level ^= DEBUG_SHOW_STACK;
10067c478bd9Sstevel@tonic-gate #else
10077c478bd9Sstevel@tonic-gate /*EMPTY*/
10087c478bd9Sstevel@tonic-gate #endif
10097c478bd9Sstevel@tonic-gate }
10107c478bd9Sstevel@tonic-gate
10117c478bd9Sstevel@tonic-gate static void
print_bytes_header(int width,int offset)10127c478bd9Sstevel@tonic-gate print_bytes_header(int width, int offset)
10137c478bd9Sstevel@tonic-gate {
10147c478bd9Sstevel@tonic-gate int i;
10157c478bd9Sstevel@tonic-gate
10167c478bd9Sstevel@tonic-gate for (i = 0; i < width; i++)
10177c478bd9Sstevel@tonic-gate log_message(MSG_INFO, " ");
10187c478bd9Sstevel@tonic-gate log_message(MSG_INFO, " ");
10197c478bd9Sstevel@tonic-gate for (i = 0; i < 16; i++) {
10207c478bd9Sstevel@tonic-gate if (i == 8)
10217c478bd9Sstevel@tonic-gate log_message(MSG_INFO, " ");
10227c478bd9Sstevel@tonic-gate if (i == offset)
10237c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "\\/ ");
10247c478bd9Sstevel@tonic-gate else
10257c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "%2x ", i);
10267c478bd9Sstevel@tonic-gate }
10277c478bd9Sstevel@tonic-gate log_message(MSG_INFO, " ");
10287c478bd9Sstevel@tonic-gate for (i = 0; i < 16; i++) {
10297c478bd9Sstevel@tonic-gate if (i == offset)
10307c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "v");
10317c478bd9Sstevel@tonic-gate else
10327c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "%x", i);
10337c478bd9Sstevel@tonic-gate }
10347c478bd9Sstevel@tonic-gate log_message(MSG_INFO, "\n");
10357c478bd9Sstevel@tonic-gate }
10367c478bd9Sstevel@tonic-gate
10377c478bd9Sstevel@tonic-gate static void
dump(fcode_env_t * env)10387c478bd9Sstevel@tonic-gate dump(fcode_env_t *env)
10397c478bd9Sstevel@tonic-gate {
10407c478bd9Sstevel@tonic-gate uchar_t *data;
10417c478bd9Sstevel@tonic-gate int len, offset;
10427c478bd9Sstevel@tonic-gate char buf[20];
10437c478bd9Sstevel@tonic-gate
10447c478bd9Sstevel@tonic-gate len = POP(DS);
10457c478bd9Sstevel@tonic-gate data = (uchar_t *)POP(DS);
10467c478bd9Sstevel@tonic-gate offset = ((long)data) & 0xf;
10477c478bd9Sstevel@tonic-gate len += offset;
10487c478bd9Sstevel@tonic-gate data = (uchar_t *)((long)data & ~0xf);
1049*09e6639bSToomas Soome (void) sprintf(buf, "%p", data);
10507c478bd9Sstevel@tonic-gate print_bytes_header(strlen(buf), offset);
10517c478bd9Sstevel@tonic-gate for (len += offset; len > 0; len -= 16, data += 16)
10527c478bd9Sstevel@tonic-gate dump_line(data);
10537c478bd9Sstevel@tonic-gate }
10547c478bd9Sstevel@tonic-gate
10557c478bd9Sstevel@tonic-gate static acf_t
do_sifting(fcode_env_t * env,acf_t acf,void * pat)10567c478bd9Sstevel@tonic-gate do_sifting(fcode_env_t *env, acf_t acf, void *pat)
10577c478bd9Sstevel@tonic-gate {
10587c478bd9Sstevel@tonic-gate char *name;
10597c478bd9Sstevel@tonic-gate
10607c478bd9Sstevel@tonic-gate if ((name = get_name(ACF_TO_LINK(acf))) != NULL && strstr(name, pat))
10617c478bd9Sstevel@tonic-gate output_acf_name(acf);
10627c478bd9Sstevel@tonic-gate return (NULL);
10637c478bd9Sstevel@tonic-gate }
10647c478bd9Sstevel@tonic-gate
10657c478bd9Sstevel@tonic-gate static void
sifting(fcode_env_t * env)10667c478bd9Sstevel@tonic-gate sifting(fcode_env_t *env)
10677c478bd9Sstevel@tonic-gate {
10687c478bd9Sstevel@tonic-gate char *pat;
10697c478bd9Sstevel@tonic-gate
10707c478bd9Sstevel@tonic-gate if ((pat = parse_a_string(env, NULL)) != NULL) {
10717c478bd9Sstevel@tonic-gate (void) search_all_dictionaries(env, do_sifting, pat);
10727c478bd9Sstevel@tonic-gate output_acf_name(NULL);
10737c478bd9Sstevel@tonic-gate }
10747c478bd9Sstevel@tonic-gate }
10757c478bd9Sstevel@tonic-gate
10767c478bd9Sstevel@tonic-gate void
print_level(int level,int * doprint)10777c478bd9Sstevel@tonic-gate print_level(int level, int *doprint)
10787c478bd9Sstevel@tonic-gate {
10797c478bd9Sstevel@tonic-gate int i;
10807c478bd9Sstevel@tonic-gate
10817c478bd9Sstevel@tonic-gate if (*doprint) {
10827c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, "\n ");
10837c478bd9Sstevel@tonic-gate for (i = 0; i < level; i++)
10847c478bd9Sstevel@tonic-gate log_message(MSG_DEBUG, " ");
10857c478bd9Sstevel@tonic-gate *doprint = 0;
10867c478bd9Sstevel@tonic-gate }
10877c478bd9Sstevel@tonic-gate }
10887c478bd9Sstevel@tonic-gate
10897c478bd9Sstevel@tonic-gate #define BI_QUOTE 1
10907c478bd9Sstevel@tonic-gate #define BI_BLIT 2
10917c478bd9Sstevel@tonic-gate #define BI_BDO 3
10927c478bd9Sstevel@tonic-gate #define BI_QDO 4
10937c478bd9Sstevel@tonic-gate #define BI_BR 5
10947c478bd9Sstevel@tonic-gate #define BI_QBR 6
10957c478bd9Sstevel@tonic-gate #define BI_BOF 7
10967c478bd9Sstevel@tonic-gate #define BI_LOOP 8
10977c478bd9Sstevel@tonic-gate #define BI_PLOOP 9
10987c478bd9Sstevel@tonic-gate #define BI_TO 10
10997c478bd9Sstevel@tonic-gate #define BI_SEMI 11
11007c478bd9Sstevel@tonic-gate #define BI_COLON 12
11017c478bd9Sstevel@tonic-gate #define BI_NOOP 13
11027c478bd9Sstevel@tonic-gate #define BI_NOTYET 14 /* unimplented in "see" */
11037c478bd9Sstevel@tonic-gate
11047c478bd9Sstevel@tonic-gate struct bitab bitab[] = {
11057c478bd9Sstevel@tonic-gate (token_t)("e_ptr), "\"", BI_QUOTE,
11067c478bd9Sstevel@tonic-gate (token_t)(&blit_ptr), "blit", BI_BLIT,
11077c478bd9Sstevel@tonic-gate (token_t)(&do_bdo_ptr), "do", BI_BDO,
11087c478bd9Sstevel@tonic-gate (token_t)(&do_bqdo_ptr), "?do", BI_QDO,
11097c478bd9Sstevel@tonic-gate (token_t)(&bbranch_ptrs[0]), "br", BI_BR,
11107c478bd9Sstevel@tonic-gate (token_t)(&bbranch_ptrs[1]), "qbr", BI_QBR,
11117c478bd9Sstevel@tonic-gate (token_t)(&bbranch_ptrs[2]), "bof", BI_BOF,
11127c478bd9Sstevel@tonic-gate (token_t)(&do_loop_ptr), "loop", BI_LOOP,
11137c478bd9Sstevel@tonic-gate (token_t)(&do_ploop_ptr), "+loop", BI_PLOOP,
11147c478bd9Sstevel@tonic-gate (token_t)(&to_ptr), "to", BI_NOOP,
11157c478bd9Sstevel@tonic-gate (token_t)(&semi_ptr), ";", BI_SEMI,
11167c478bd9Sstevel@tonic-gate (token_t)(&do_colon), ":", BI_COLON,
11177c478bd9Sstevel@tonic-gate (token_t)(&tlit_ptr), "[']", BI_NOOP,
11187c478bd9Sstevel@tonic-gate (token_t)(&do_leave_ptr), "leave", BI_NOTYET,
11197c478bd9Sstevel@tonic-gate (token_t)(&create_ptr), "create", BI_NOTYET,
11207c478bd9Sstevel@tonic-gate (token_t)(&does_ptr), "does>", BI_NOTYET,
11217c478bd9Sstevel@tonic-gate (token_t)(&value_defines[0][0]), "a.@", BI_NOTYET,
11227c478bd9Sstevel@tonic-gate (token_t)(&value_defines[0][1]), "a.!", BI_NOTYET,
11237c478bd9Sstevel@tonic-gate (token_t)(&value_defines[0][2]), "a.nop", BI_NOTYET,
11247c478bd9Sstevel@tonic-gate (token_t)(&value_defines[1][0]), "a.i@", BI_NOTYET,
11257c478bd9Sstevel@tonic-gate (token_t)(&value_defines[1][1]), "a.i!", BI_NOTYET,
11267c478bd9Sstevel@tonic-gate (token_t)(&value_defines[1][2]), "a.iad", BI_NOTYET,
11277c478bd9Sstevel@tonic-gate (token_t)(&value_defines[2][0]), "a.defer", BI_NOTYET,
11287c478bd9Sstevel@tonic-gate (token_t)(&value_defines[2][1]), "a.@", BI_NOTYET,
11297c478bd9Sstevel@tonic-gate (token_t)(&value_defines[2][2]), "a.nop", BI_NOTYET,
11307c478bd9Sstevel@tonic-gate (token_t)(&value_defines[3][0]), "a.defexec", BI_NOTYET,
11317c478bd9Sstevel@tonic-gate (token_t)(&value_defines[3][1]), "a.iset", BI_NOTYET,
11327c478bd9Sstevel@tonic-gate (token_t)(&value_defines[3][2]), "a.iad", BI_NOTYET,
11337c478bd9Sstevel@tonic-gate (token_t)(&value_defines[4][0]), "a.binit", BI_NOTYET,
11347c478bd9Sstevel@tonic-gate (token_t)(&value_defines[4][1]), "a.2drop", BI_NOTYET,
11357c478bd9Sstevel@tonic-gate (token_t)(&value_defines[4][2]), "a.nop", BI_NOTYET,
11367c478bd9Sstevel@tonic-gate (token_t)(&value_defines[5][0]), "a.ibinit", BI_NOTYET,
1137