xref: /titanic_44/usr/src/lib/efcode/engine/debug.c (revision ee5416c9d7e449233197d5d20bc6b81e4ff091b2)
1 /*
2  * CDDL HEADER START
3  *
4  * The contents of this file are subject to the terms of the
5  * Common Development and Distribution License, Version 1.0 only
6  * (the "License").  You may not use this file except in compliance
7  * with the License.
8  *
9  * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10  * or http://www.opensolaris.org/os/licensing.
11  * See the License for the specific language governing permissions
12  * and limitations under the License.
13  *
14  * When distributing Covered Code, include this CDDL HEADER in each
15  * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16  * If applicable, add the following below this CDDL HEADER, with the
17  * fields enclosed by brackets "[]" replaced with your own identifying
18  * information: Portions Copyright [yyyy] [name of copyright owner]
19  *
20  * CDDL HEADER END
21  */
22 /*
23  * Copyright 2005 Sun Microsystems, Inc.  All rights reserved.
24  * Use is subject to license terms.
25  */
26 
27 #pragma ident	"%Z%%M%	%I%	%E% SMI"
28 
29 #include <stdio.h>
30 #include <string.h>
31 #include <stdlib.h>
32 #include <stdarg.h>
33 #include <unistd.h>
34 #include <errno.h>
35 #include <ctype.h>
36 
37 #include <fcode/private.h>
38 #include <fcode/log.h>
39 
40 #ifndef DEBUG_LVL
41 #define	DEBUG_LVL	0
42 #endif
43 
44 struct bitab {
45 	token_t bi_ptr;
46 	char *bi_name;
47 	int bi_type;
48 };
49 
50 struct bitab *lookup_builtin(token_t);
51 
52 static int debug_level = DEBUG_LVL;
53 
54 void
55 set_interpreter_debug_level(long lvl)
56 {
57 	debug_level = lvl;
58 }
59 
60 long
61 get_interpreter_debug_level(void)
62 {
63 	return (debug_level);
64 }
65 
66 void
67 output_data_stack(fcode_env_t *env, int msglevel)
68 {
69 	int i;
70 
71 	log_message(msglevel, "( ");
72 	if (DS > env->ds0) {
73 		for (i = 0; i < (DS - env->ds0); i++)
74 			log_message(msglevel, "%llx ",
75 			    (uint64_t)(env->ds0[i + 1]));
76 	} else
77 		log_message(msglevel, "<empty> ");
78 	log_message(msglevel, ") ");
79 }
80 
81 void
82 output_return_stack(fcode_env_t *env, int show_wa, int msglevel)
83 {
84 	int i;
85 	int anyout = 0;
86 
87 	log_message(msglevel, "R:( ");
88 	if (show_wa) {
89 		log_message(msglevel, "%s ",
90 		    acf_backup_search(env, (acf_t)WA));
91 		anyout++;
92 	}
93 	if (IP) {
94 		anyout++;
95 		log_message(msglevel, "%s ", acf_backup_search(env, IP));
96 	}
97 	for (i = (RS - env->rs0) - 1; i > 0; i--) {
98 		anyout++;
99 		log_message(msglevel, "%s ",
100 			    acf_backup_search(env, (acf_t)env->rs0[i+1]));
101 	}
102 	if (!anyout)
103 		log_message(msglevel, "<empty> ");
104 	log_message(msglevel, ") ");
105 }
106 
107 void
108 dump_comma(fcode_env_t *env, char *type)
109 {
110 	xforth_t d;
111 
112 	if (strcmp(type, "x,") == 0)
113 		d = peek_xforth(env);
114 	else
115 		d = TOS;
116 	log_message(MSG_FC_DEBUG, "%s %p, %llx\n", type, HERE, (uint64_t)d);
117 }
118 
119 static int ndebug_names;
120 #define	MAXDEBUG_NAMES	10
121 static char *debug_names[MAXDEBUG_NAMES];
122 
123 static int ndebug_acfs;
124 #define	MAXDEBUG_ACFS	10
125 static acf_t debug_acfs[MAXDEBUG_ACFS];
126 
127 void
128 add_debug_acf(fcode_env_t *env, acf_t acf)
129 {
130 	int i;
131 
132 	for (i = 0; i < ndebug_acfs; i++)
133 		if (acf == debug_acfs[i])
134 			return;
135 
136 	if (!within_dictionary(env, acf))
137 		log_message(MSG_ERROR, "Can't debug builtin\n");
138 	else if (ndebug_acfs >= MAXDEBUG_ACFS)
139 		log_message(MSG_ERROR, "Too many debug ACF's\n");
140 	else {
141 		debug_acfs[ndebug_acfs++] = acf;
142 		*LINK_TO_FLAGS(ACF_TO_LINK(acf)) |= FLAG_DEBUG;
143 	}
144 }
145 
146 static void
147 paren_debug(fcode_env_t *env)
148 {
149 	acf_t acf;
150 
151 	acf = (acf_t)POP(DS);
152 	if (!within_dictionary(env, acf)) {
153 		log_message(MSG_INFO, "acf: %llx not in dictionary\n",
154 		    (uint64_t)acf);
155 		return;
156 	}
157 	if ((acf_t)_ALIGN(acf, token_t) != acf) {
158 		log_message(MSG_INFO, "acf: %llx not aligned\n",
159 		    (uint64_t)acf);
160 		return;
161 	}
162 	if (*acf != (token_t)(&do_colon)) {
163 		log_message(MSG_INFO, "acf: %llx not a colon-def\n",
164 		    (uint64_t)acf);
165 		return;
166 	}
167 	add_debug_acf(env, acf);
168 }
169 
170 static void
171 debug(fcode_env_t *env)
172 {
173 	fstack_t d;
174 	char *word;
175 	acf_t acf;
176 
177 	parse_word(env);
178 	dollar_find(env);
179 	d = POP(DS);
180 	if (d) {
181 		acf = (acf_t)POP(DS);
182 		add_debug_acf(env, acf);
183 	} else if (ndebug_names >= MAXDEBUG_NAMES) {
184 		log_message(MSG_ERROR, "Too many forward debug words\n");
185 		two_drop(env);
186 	} else {
187 		word = pop_a_duped_string(env, NULL);
188 		log_message(MSG_INFO, "Forward defined word: %s\n", word);
189 		debug_names[ndebug_names++] = word;
190 	}
191 }
192 
193 /*
194  * Eliminate dups and add vocabulary forth to end if not already on list.
195  */
196 static void
197 order_to_dict_list(fcode_env_t *env, token_t *order[])
198 {
199 	int i, j, norder = 0;
200 
201 	if (env->current)
202 		order[norder++] = env->current;
203 	for (i = env->order_depth; i >= 0; i--) {
204 		for (j = 0; j < norder && order[j] != env->order[i]; j++)
205 			;
206 		if (j == norder)
207 			order[norder++] = env->order[i];
208 	}
209 	for (j = 0; j < norder && order[j] != (token_t *)&env->forth_voc_link;
210 	    j++)
211 		;
212 	if (j == norder)
213 		order[norder++] = (token_t *)&env->forth_voc_link;
214 	order[norder] = NULL;
215 }
216 
217 static acf_t
218 search_all_dictionaries(fcode_env_t *env,
219     acf_t (*fn)(fcode_env_t *, acf_t, void *),
220     void *arg)
221 {
222 	token_t *order[MAX_ORDER+1];
223 	int i;
224 	token_t *dptr;
225 	acf_t acf;
226 
227 	order_to_dict_list(env, order);
228 	for (i = 0; (dptr = order[i]) != NULL; i++) {
229 		for (dptr = (token_t *)(*dptr); dptr;
230 		    dptr = (token_t *)(*dptr))
231 			if ((acf = (*fn)(env, LINK_TO_ACF(dptr), arg)) != NULL)
232 				return (acf);
233 	}
234 	return (NULL);
235 }
236 
237 char *
238 acf_to_str(acf_t acf)
239 {
240 	static char msg[(sizeof (acf) * 2) + 3];
241 
242 	sprintf(msg, "(%08p)", acf);
243 	return (msg);
244 }
245 
246 char *
247 get_name_or_acf(token_t *dptr)
248 {
249 	char *name;
250 
251 	if ((name = get_name(dptr)) != NULL)
252 		return (name);
253 	return (acf_to_str(LINK_TO_ACF(dptr)));
254 }
255 
256 static void
257 output_acf_name(acf_t acf)
258 {
259 	char *name;
260 	token_t *dptr;
261 	static int acf_count = 0;
262 
263 	if (acf == NULL) {
264 		if (acf_count)
265 			log_message(MSG_INFO, "\n");
266 		acf_count = 0;
267 		return;
268 	}
269 	dptr = ACF_TO_LINK(acf);
270 	if ((name = get_name(dptr)) == NULL)
271 		name = "<noname>";
272 
273 	log_message(MSG_INFO, "%24s (%08p)", name, acf);
274 	if (++acf_count >= 2) {
275 		log_message(MSG_INFO, "\n");
276 		acf_count = 0;
277 	} else
278 		log_message(MSG_INFO, "    ");
279 }
280 
281 static void
282 dot_debug(fcode_env_t *env)
283 {
284 	int i;
285 	token_t *dptr;
286 
287 	if (ndebug_names == 0)
288 		log_message(MSG_INFO, "No forward debug words\n");
289 	else {
290 		for (i = 0; i < ndebug_names; i++)
291 			log_message(MSG_INFO, "%s Forward\n", debug_names[i]);
292 	}
293 	if (ndebug_acfs == 0)
294 		log_message(MSG_INFO, "No debug words\n");
295 	else {
296 		for (i = 0; i < ndebug_acfs; i++)
297 			log_message(MSG_INFO, "%s\n",
298 			    get_name_or_acf(ACF_TO_LINK(debug_acfs[i])));
299 	}
300 }
301 
302 static void
303 do_undebug(fcode_env_t *env, char *name)
304 {
305 	int i;
306 
307 	for (i = 0; i < ndebug_names; i++) {
308 		if (strcmp(debug_names[i], name) == 0) {
309 			log_message(MSG_INFO, "Undebugging forward word %s\n",
310 			    name);
311 			FREE(debug_names[i]);
312 			for (i++; i < ndebug_names; i++)
313 				debug_names[i - 1] = debug_names[i];
314 			ndebug_names--;
315 			break;
316 		}
317 	}
318 }
319 
320 static void
321 undebug(fcode_env_t *env)
322 {
323 	fstack_t d;
324 	acf_t acf;
325 	flag_t *flagp;
326 	char *name;
327 	int i, j;
328 
329 	parse_word(env);
330 	two_dup(env);
331 	dollar_find(env);
332 	d = POP(DS);
333 	if (d) {
334 		acf = (acf_t)POP(DS);
335 		flagp = LINK_TO_FLAGS(ACF_TO_LINK(acf));
336 		if ((*flagp & FLAG_DEBUG) == 0)
337 			log_message(MSG_WARN, "Word not debugged?\n");
338 		else {
339 			log_message(MSG_INFO, "Undebugging acf: %p\n", acf);
340 			*flagp &= ~FLAG_DEBUG;
341 			for (i = 0; i < ndebug_acfs; i++) {
342 				if (debug_acfs[i] == acf) {
343 					for (j = i + 1; j < ndebug_acfs; j++)
344 						debug_acfs[j-1] = debug_acfs[j];
345 					ndebug_acfs--;
346 					break;
347 				}
348 			}
349 		}
350 	} else
351 		two_drop(env);
352 	name = pop_a_string(env, NULL);
353 	do_undebug(env, name);
354 }
355 
356 int
357 name_is_debugged(fcode_env_t *env, char *name)
358 {
359 	int i;
360 
361 	if (ndebug_names <= 0)
362 		return (0);
363 	for (i = 0; i < ndebug_names; i++)
364 		if (strcmp(debug_names[i], name) == 0)
365 			return (1);
366 	return (0);
367 }
368 
369 /*
370  * This is complicated by being given ACF's to temporary compile words which
371  * don't have a header.
372  */
373 int
374 is_debug_word(fcode_env_t *env, acf_t acf)
375 {
376 	flag_t *flagp;
377 	int i;
378 
379 	/* check to see if any words are being debugged */
380 	if (ndebug_acfs == 0)
381 		return (0);
382 
383 	/* only words in dictionary can be debugged */
384 	if (!within_dictionary(env, acf))
385 		return (0);
386 
387 	/* check that word has "FLAG_DEBUG" on */
388 	flagp = LINK_TO_FLAGS(ACF_TO_LINK(acf));
389 	if ((*flagp & FLAG_DEBUG) == 0)
390 		return (0);
391 
392 	/* look in table of debug acf's */
393 	for (i = 0; i < ndebug_acfs; i++)
394 		if (debug_acfs[i] == acf)
395 			return (1);
396 	return (0);
397 }
398 
399 #define	MAX_DEBUG_STACK	100
400 token_t debug_low[MAX_DEBUG_STACK], debug_high[MAX_DEBUG_STACK];
401 int debug_prev_level[MAX_DEBUG_STACK];
402 int debug_curr_level[MAX_DEBUG_STACK];
403 int ndebug_stack = 0;
404 
405 void
406 debug_set_level(fcode_env_t *env, int level)
407 {
408 	debug_curr_level[ndebug_stack - 1] = level;
409 	set_interpreter_debug_level(level);
410 }
411 
412 token_t
413 find_semi_in_colon_def(fcode_env_t *env, acf_t acf)
414 {
415 	for (; within_dictionary(env, acf); acf++)
416 		if (*acf == (token_t)(&semi_ptr))
417 			return ((token_t)acf);
418 	return (0);
419 }
420 
421 void
422 check_for_debug_entry(fcode_env_t *env)
423 {
424 	int top;
425 
426 	if (is_debug_word(env, WA) && ndebug_stack < MAX_DEBUG_STACK) {
427 		top = ndebug_stack++;
428 		debug_prev_level[top] = get_interpreter_debug_level();
429 		debug_low[top] = (token_t)WA;
430 		if (*WA == (token_t)(&do_colon)) {
431 			debug_high[top] =
432 			    find_semi_in_colon_def(env, WA);
433 		} else {
434 			debug_high[top] = 0;	/* marker... */
435 		}
436 		debug_set_level(env, DEBUG_STEPPING);
437 		output_step_message(env);
438 	}
439 }
440 
441 void
442 check_for_debug_exit(fcode_env_t *env)
443 {
444 	if (ndebug_stack) {
445 		int top = ndebug_stack - 1;
446 
447 		if (debug_high[top] == 0) {
448 			set_interpreter_debug_level(debug_prev_level[top]);
449 			ndebug_stack--;
450 		} else if ((token_t)IP >= debug_low[top] &&
451 		    (token_t)IP <= debug_high[top]) {
452 			set_interpreter_debug_level(debug_curr_level[top]);
453 		} else {
454 			set_interpreter_debug_level(debug_prev_level[top]);
455 		}
456 	}
457 }
458 
459 void
460 check_semi_debug_exit(fcode_env_t *env)
461 {
462 	if (ndebug_stack) {
463 		int top = ndebug_stack - 1;
464 
465 		if ((token_t)(IP - 1) == debug_high[top]) {
466 			set_interpreter_debug_level(debug_prev_level[top]);
467 			ndebug_stack--;
468 		}
469 	}
470 }
471 
472 /*
473  * Really entering do_run, since this may be a recursive entry to do_run,
474  * we need to set the debug level to what it was previously.
475  */
476 int
477 current_debug_state(fcode_env_t *env)
478 {
479 	if (ndebug_stack) {
480 		int top = ndebug_stack - 1;
481 		set_interpreter_debug_level(debug_prev_level[top]);
482 	}
483 	return (ndebug_stack);
484 }
485 
486 void
487 clear_debug_state(fcode_env_t *env, int oldstate)
488 {
489 	if (ndebug_stack && oldstate <= ndebug_stack) {
490 		set_interpreter_debug_level(debug_prev_level[oldstate]);
491 		ndebug_stack = oldstate;
492 	}
493 }
494 
495 void
496 unbug(fcode_env_t *env)
497 {
498 	int i;
499 	token_t *link;
500 	flag_t *flag;
501 
502 	for (i = ndebug_stack - 1; i >= 0; i--) {
503 		link = ACF_TO_LINK(debug_low[i]);
504 		flag = LINK_TO_FLAGS(link);
505 		*flag &= ~FLAG_DEBUG;
506 	}
507 	clear_debug_state(env, 0);
508 }
509 
510 void
511 output_vitals(fcode_env_t *env)
512 {
513 	log_message(MSG_FC_DEBUG, "IP=%p, *IP=%p, WA=%p, *WA=%p ", IP,
514 	    (IP ? *IP : 0), WA, (WA ? *WA : 0));
515 }
516 
517 int
518 do_exec_debug(fcode_env_t *env, void *fn)
519 {
520 	int dl = debug_level;
521 	int show_wa = 1;
522 
523 	if ((dl & (DEBUG_EXEC_DUMP_DS | DEBUG_EXEC_DUMP_RS |
524 	    DEBUG_EXEC_SHOW_VITALS | DEBUG_EXEC_TRACE | DEBUG_TRACING |
525 	    DEBUG_STEPPING)) == 0)
526 		return (0);
527 
528 	if (dl & DEBUG_STEPPING) {
529 		dl |= DEBUG_EXEC_DUMP_DS;
530 	}
531 	if (dl & (DEBUG_STEPPING | DEBUG_EXEC_TRACE)) {
532 		log_message(MSG_FC_DEBUG, "%-15s ", acf_to_name(env, WA));
533 		show_wa = 0;
534 	}
535 	if (dl & DEBUG_EXEC_DUMP_DS)
536 		output_data_stack(env, MSG_FC_DEBUG);
537 	if (dl & DEBUG_EXEC_DUMP_RS)
538 		output_return_stack(env, show_wa, MSG_FC_DEBUG);
539 	if (dl & DEBUG_EXEC_SHOW_VITALS)
540 		output_vitals(env);
541 	if (dl & DEBUG_TRACING)
542 		do_fclib_trace(env, (void *) fn);
543 	log_message(MSG_FC_DEBUG, "\n");
544 	if (dl & DEBUG_STEPPING)
545 		return (do_fclib_step(env));
546 	return (0);
547 }
548 
549 static void
550 smatch(fcode_env_t *env)
551 {
552 	int len;
553 	char *str, *p;
554 
555 	if ((str = parse_a_string(env, &len)) == NULL)
556 		log_message(MSG_INFO, "smatch: no string\n");
557 	else {
558 		for (p = (char *)env->base; p < (char *)HERE; p++)
559 			if (memcmp(p, str, len) == 0)
560 				log_message(MSG_DEBUG, "%p\n", p);
561 	}
562 }
563 
564 void
565 check_vitals(fcode_env_t *env)
566 {
567 	int i;
568 	token_t *dptr;
569 
570 	dptr = env->current;
571 	if (*dptr && !within_dictionary(env, (uchar_t *)*dptr))
572 		log_message(MSG_ERROR, "Current: %p outside dictionary\n",
573 		    *dptr);
574 	for (i = env->order_depth; i >= 0; i--) {
575 		dptr = env->order[i];
576 		if (!dptr)
577 			continue;
578 		if (*dptr && !within_dictionary(env, (uchar_t *)*dptr))
579 			log_message(MSG_ERROR, "Order%d: %p outside"
580 			    " dictionary\n", i, *dptr);
581 	}
582 	if (HERE < env->base || HERE >= env->base + dict_size) {
583 		log_message(MSG_ERROR, "HERE: %p outside range\n", HERE);
584 	}
585 	if (DS < env->ds0 || DS >= &env->ds0[stack_size]) {
586 		forth_abort(env, "DS: %p outside range\n", DS);
587 	}
588 	if (RS < env->rs0 || RS >= &env->rs0[stack_size]) {
589 		log_message(MSG_ERROR, "RS: %p outside range\n", RS);
590 		RS = env->rs0;
591 	}
592 	if (IP && !within_dictionary(env, IP))
593 		log_message(MSG_ERROR, "IP: %p outside dictionary\n", IP);
594 	if (!within_dictionary(env, (void *)env->forth_voc_link))
595 		log_message(MSG_ERROR, "forth_voc_link: %p outside"
596 		    " dictionary\n", env->forth_voc_link);
597 }
598 
599 static void
600 dump_table(fcode_env_t *env)
601 {
602 	int i;
603 
604 	for (i = 0; i < MAX_FCODE; i++) {
605 		if (*(env->table[i].apf) != (token_t)(&f_error)) {
606 			log_message(MSG_DEBUG, "Token: %4x %32s acf = %8p,"
607 			    " %8p\n", i, env->table[i].name, env->table[i].apf,
608 			    *(env->table[i].apf));
609 		}
610 	}
611 	log_message(MSG_DEBUG, "%d FCODES implemented\n", fcode_impl_count);
612 }
613 
614 void
615 verify_usage(fcode_env_t *env)
616 {
617 	int i, untested = 0;
618 
619 	for (i = 0; i < MAX_FCODE; i++) {
620 		int verify;
621 
622 		verify = env->table[i].flags & (ANSI_WORD|P1275_WORD);
623 		if ((verify) &&
624 #ifdef DEBUG
625 			(env->table[i].usage == 0) &&
626 #endif
627 			(env->table[i].apf)) {
628 			log_message(MSG_DEBUG,
629 			    "Untested: %4x %32s acf = %8p, %8p\n", i,
630 			    env->table[i].name, env->table[i].apf,
631 			    *(env->table[i].apf));
632 			untested++;
633 		}
634 	}
635 	if (untested)
636 		log_message(MSG_DEBUG, "%d untested tokens\n", untested);
637 }
638 
639 static void
640 debugf(fcode_env_t *env)
641 {
642 	PUSH(DS, (fstack_t)&debug_level);
643 }
644 
645 static void
646 control(fcode_env_t *env)
647 {
648 	PUSH(DS, (fstack_t)&env->control);
649 }
650 
651 struct bittab {
652 	int b_bitval;
653 	char *b_bitname;
654 } bittab[] = {
655 	DEBUG_CONTEXT,		"context",
656 	DEBUG_BYTELOAD_DS,	"byteload-ds",
657 	DEBUG_BYTELOAD_RS,	"byteload-rs",
658 	DEBUG_BYTELOAD_TOKENS,	"byteload-tokens",
659 	DEBUG_NEW_TOKEN,	"new-token",
660 	DEBUG_EXEC_TRACE,	"exec-trace",
661 	DEBUG_EXEC_SHOW_VITALS,	"exec-show-vitals",
662 	DEBUG_EXEC_DUMP_DS,	"exec-dump-ds",
663 	DEBUG_EXEC_DUMP_RS,	"exec-dump-rs",
664 	DEBUG_COMMA,		"comma",
665 	DEBUG_HEADER,		"header",
666 	DEBUG_EXIT_WORDS,	"exit-words",
667 	DEBUG_EXIT_DUMP,	"exit-dump",
668 	DEBUG_DUMP_TOKENS,	"dump-tokens",
669 	DEBUG_COLON,		"colon",
670 	DEBUG_NEXT_VITALS,	"next-vitals",
671 	DEBUG_VOC_FIND,		"voc-find",
672 	DEBUG_DUMP_DICT_TOKENS,	"dump-dict-tokens",
673 	DEBUG_TOKEN_USAGE,	"token-usage",
674 	DEBUG_DUMP_TOKEN_TABLE,	"dump-token-table",
675 	DEBUG_SHOW_STACK,	"show-stack",
676 	DEBUG_SHOW_RS,		"show-rs",
677 	DEBUG_TRACING,		"tracing",
678 	DEBUG_TRACE_STACK,	"trace-stack",
679 	DEBUG_CALL_METHOD,	"call-method",
680 	DEBUG_ACTIONS,		"actions",
681 	DEBUG_STEPPING,		"stepping",
682 	DEBUG_REG_ACCESS,	"reg-access",
683 	DEBUG_ADDR_ABUSE,	"addr-abuse",
684 	DEBUG_FIND_FCODE,	"find-fcode",
685 	DEBUG_UPLOAD,		"upload",
686 	0
687 };
688 
689 void
690 debug_flags_to_output(fcode_env_t *env, int flags)
691 {
692 	int first = 1, i;
693 
694 	for (i = 0; bittab[i].b_bitval != 0; i++)
695 		if (bittab[i].b_bitval & flags) {
696 			if (!first)
697 				log_message(MSG_INFO, ",");
698 			first = 0;
699 			log_message(MSG_INFO, bittab[i].b_bitname);
700 		}
701 	if (first)
702 		log_message(MSG_INFO, "<empty>");
703 	log_message(MSG_INFO, "\n");
704 }
705 
706 static void
707 dot_debugf(fcode_env_t *env)
708 {
709 	debug_flags_to_output(env, debug_level);
710 }
711 
712 static void
713 debugf_qmark(fcode_env_t *env)
714 {
715 	debug_flags_to_output(env, 0xffffffff);
716 }
717 
718 int
719 debug_flags_to_mask(char *str)
720 {
721 	int flags = 0;
722 	char *p;
723 	int i;
724 
725 	if (isdigit(*str)) {
726 		if (*str == '0') {
727 			str++;
728 			if (*str == 'x' || *str == 'X') {
729 				sscanf(str + 1, "%x", &flags);
730 			} else
731 				sscanf(str, "%o", &flags);
732 		} else
733 			sscanf(str, "%d", &flags);
734 		return (flags);
735 	}
736 	if (strcmp(str, "clear") == 0)
737 		return (0);
738 	if (strcmp(str, "all") == 0)
739 		return (0xffffffff & ~DEBUG_STEPPING);
740 	if (*str) {
741 		do {
742 			if (p = strchr(str, ','))
743 				*p++ = '\0';
744 			for (i = 0; bittab[i].b_bitname != 0; i++)
745 				if (strcmp(str, bittab[i].b_bitname) == 0) {
746 					flags |= bittab[i].b_bitval;
747 					break;
748 			}
749 			if (bittab[i].b_bitname == 0)
750 				log_message(MSG_WARN,
751 				    "Unknown debug flag: '%s'\n", str);
752 			str = p;
753 		} while (p);
754 	}
755 	return (flags);
756 }
757 
758 static void
759 set_debugf(fcode_env_t *env)
760 {
761 	char *str;
762 
763 	str = parse_a_string(env, NULL);
764 	debug_level = debug_flags_to_mask(str);
765 }
766 
767 static acf_t
768 show_a_word(fcode_env_t *env, acf_t acf, void *arg)
769 {
770 	static int nshow_words = 0;
771 
772 	if (acf == NULL) {
773 		if (nshow_words > 0) {
774 			log_message(MSG_DEBUG, "\n");
775 			nshow_words = 0;
776 		}
777 		return (NULL);
778 	}
779 	log_message(MSG_DEBUG, "%15s  ", get_name_or_acf(ACF_TO_LINK(acf)));
780 	nshow_words++;
781 	if (nshow_words >= 4) {
782 		log_message(MSG_DEBUG, "\n");
783 		nshow_words = 0;
784 	}
785 	return (NULL);
786 }
787 
788 void
789 words(fcode_env_t *env)
790 {
791 	(void) search_all_dictionaries(env, show_a_word, NULL);
792 	(void) show_a_word(env, NULL, NULL);
793 }
794 
795 static acf_t
796 dump_a_word(fcode_env_t *env, acf_t acf, void *arg)
797 {
798 	output_acf_name(acf);
799 	return (NULL);
800 }
801 
802 void
803 dump_words(fcode_env_t *env)
804 {
805 	(void) search_all_dictionaries(env, dump_a_word, NULL);
806 	output_acf_name(NULL);
807 }
808 
809 static void
810 dump_line(uchar_t *ptr)
811 {
812 	uchar_t *byte;
813 	int i;
814 
815 	log_message(MSG_INFO, "%p  ", ptr);
816 	for (i = 0, byte = ptr; i < 16; i++) {
817 		if (i == 8)
818 			log_message(MSG_INFO, " ");
819 		log_message(MSG_INFO, "%02.2x ", *byte++);
820 	}
821 	log_message(MSG_INFO, " ");
822 	for (i = 0, byte = ptr; i < 16; i++, byte++) {
823 		log_message(MSG_INFO, "%c",
824 		    ((*byte < 0x20) || (*byte > 0x7f)) ? '.' : *byte);
825 	}
826 	log_message(MSG_INFO, "\n");
827 }
828 
829 void
830 dump_dictionary(fcode_env_t *env)
831 {
832 	uchar_t *ptr;
833 
834 	log_message(MSG_INFO, "Dictionary dump: base: %p\n", env->base);
835 	for (ptr = (uchar_t *)(((long)(env->base)) & ~0xf); ptr < HERE;
836 	    ptr += 16)
837 		dump_line(ptr);
838 }
839 
840 static char *
841 acf_to_fcode_name(fcode_env_t *env, acf_t acf)
842 {
843 	int i;
844 
845 	for (i = 0; i < MAX_FCODE; i++)
846 		if (env->table[i].apf == acf)
847 			return (env->table[i].name);
848 	return (NULL);
849 }
850 
851 static acf_t
852 acf_match(fcode_env_t *env, acf_t sacf, void *macf)
853 {
854 	if (sacf == (acf_t)macf)
855 		return (sacf);
856 	return (NULL);
857 }
858 
859 /*
860  * Given an ACF, return ptr to name or "unknown" string.
861  */
862 char *
863 acf_to_name(fcode_env_t *env, acf_t acf)
864 {
865 	struct bitab *bip;
866 	static char name_buf[256];
867 	uchar_t *p, *np;
868 	int i, n;
869 
870 	if (!within_dictionary(env, acf)) {
871 		if ((bip = lookup_builtin((token_t)acf)) != NULL)
872 			return (bip->bi_name);
873 		return (NULL);
874 	}
875 	return (get_name_or_acf(ACF_TO_LINK(acf)));
876 }
877 
878 int
879 within_dictionary(fcode_env_t *env, void *addr)
880 {
881 	return ((uchar_t *)addr >= env->base &&
882 	    (uchar_t *)addr < env->base + dict_size);
883 }
884 
885 static int
886 within_word(fcode_env_t *env, acf_t acf, acf_t wacf)
887 {
888 	if (acf == wacf || acf + 1 == wacf)
889 		return (1);
890 	if (*acf == (token_t)(&do_colon)) {
891 		do {
892 			if (acf == wacf)
893 				return (1);
894 		} while (*acf++ != (token_t)(&semi_ptr));
895 	}
896 	return (0);
897 }
898 
899 /*
900  * Given an ACF in the middle of a colon definition, search dictionary towards
901  * beginning for "colon" acf.  If we find a "semi" acf first, we're not in
902  * the middle of a colon-def (temporary execute?).
903  */
904 char *
905 acf_backup_search(fcode_env_t *env, acf_t acf)
906 {
907 	acf_t nacf;
908 	char *name;
909 
910 	if ((acf_t)_ALIGN(acf, token_t) == acf && within_dictionary(env, acf)) {
911 		for (nacf = acf; nacf >= (acf_t)env->base; nacf--)
912 			if (*nacf == (token_t)(&do_colon) ||
913 			    *nacf == (token_t)(&semi_ptr))
914 				break;
915 		if (nacf >= (acf_t)env->base && *nacf == (token_t)(&do_colon) &&
916 		    (name = get_name(ACF_TO_LINK(nacf))) != NULL)
917 			return (name);
918 	}
919 	return (acf_to_str(acf));
920 }
921 
922 /*
923  * Print out current process's C stack using /usr/proc/bin/pstack
924  */
925 void
926 ctrace(fcode_env_t *env)
927 {
928 	char buf[256];
929 	FILE *fd;
930 
931 	log_message(MSG_DEBUG, "Interpreter C Stack:\n");
932 	sprintf(buf, "/usr/proc/bin/pstack %d", getpid());
933 	if ((fd = popen(buf, "r")) == NULL)
934 		log_perror(MSG_ERROR, "Can't run: %s", buf);
935 	else {
936 		while (fgets(buf, sizeof (buf), fd))
937 			log_message(MSG_DEBUG, buf);
938 		fclose(fd);
939 	}
940 }
941 
942 /*
943  * Dump data, return stacks, try to unthread forth calling stack.
944  */
945 void
946 ftrace(fcode_env_t *env)
947 {
948 	log_message(MSG_DEBUG, "Forth Interpreter Stacks:\n");
949 	output_data_stack(env, MSG_DEBUG);
950 	output_return_stack(env, 1, MSG_DEBUG);
951 	log_message(MSG_DEBUG, "\n");
952 }
953 
954 int in_forth_abort;
955 
956 /*
957  * Handle fatal error, if interactive mode, return to ok prompt.
958  */
959 void
960 forth_abort(fcode_env_t *env, char *fmt, ...)
961 {
962 	va_list ap;
963 	char msg[256];
964 
965 	if (in_forth_abort) {
966 		log_message(MSG_FATAL, "ABORT: abort within forth_abort\n");
967 		abort();
968 	}
969 	in_forth_abort++;
970 
971 	va_start(ap, fmt);
972 	vsprintf(msg, fmt, ap);
973 	log_message(MSG_ERROR, "ABORT: %s\n", msg);
974 
975 	if (env) {
976 		ctrace(env);
977 		ftrace(env);
978 	}
979 
980 	return_to_interact(env);
981 	/*
982 	 * If not in interactive mode, return_to_interact just returns.
983 	 */
984 	exit(1);
985 }
986 
987 /*
988  * Handle fatal system call error
989  */
990 void
991 forth_perror(fcode_env_t *env, char *fmt, ...)
992 {
993 	va_list ap;
994 	char msg[256];
995 	int save_errno = errno;	/* just in case... */
996 
997 	va_start(ap, fmt);
998 	vsprintf(msg, fmt, ap);
999 
1000 	forth_abort(env, "%s: %s", msg, strerror(save_errno));
1001 }
1002 
1003 static void
1004 show_stack(fcode_env_t *env)
1005 {
1006 #ifdef DEBUG
1007 	debug_level ^= DEBUG_SHOW_STACK;
1008 #else
1009 	/*EMPTY*/
1010 #endif
1011 }
1012 
1013 static void
1014 print_bytes_header(int width, int offset)
1015 {
1016 	int i;
1017 
1018 	for (i = 0; i < width; i++)
1019 		log_message(MSG_INFO, " ");
1020 	log_message(MSG_INFO, "  ");
1021 	for (i = 0; i < 16; i++) {
1022 		if (i == 8)
1023 			log_message(MSG_INFO, " ");
1024 		if (i == offset)
1025 			log_message(MSG_INFO, "\\/ ");
1026 		else
1027 			log_message(MSG_INFO, "%2x ", i);
1028 	}
1029 	log_message(MSG_INFO, " ");
1030 	for (i = 0; i < 16; i++) {
1031 		if (i == offset)
1032 			log_message(MSG_INFO, "v");
1033 		else
1034 			log_message(MSG_INFO, "%x", i);
1035 	}
1036 	log_message(MSG_INFO, "\n");
1037 }
1038 
1039 static void
1040 dump(fcode_env_t *env)
1041 {
1042 	uchar_t *data;
1043 	int len, offset;
1044 	char buf[20];
1045 
1046 	len = POP(DS);
1047 	data = (uchar_t *)POP(DS);
1048 	offset = ((long)data) & 0xf;
1049 	len += offset;
1050 	data = (uchar_t *)((long)data & ~0xf);
1051 	sprintf(buf, "%p", data);
1052 	print_bytes_header(strlen(buf), offset);
1053 	for (len += offset; len > 0; len -= 16, data += 16)
1054 		dump_line(data);
1055 }
1056 
1057 static acf_t
1058 do_sifting(fcode_env_t *env, acf_t acf, void *pat)
1059 {
1060 	char *name;
1061 
1062 	if ((name = get_name(ACF_TO_LINK(acf))) != NULL && strstr(name, pat))
1063 		output_acf_name(acf);
1064 	return (NULL);
1065 }
1066 
1067 static void
1068 sifting(fcode_env_t *env)
1069 {
1070 	char *pat;
1071 
1072 	if ((pat = parse_a_string(env, NULL)) != NULL) {
1073 		(void) search_all_dictionaries(env, do_sifting, pat);
1074 		output_acf_name(NULL);
1075 	}
1076 }
1077 
1078 void
1079 print_level(int level, int *doprint)
1080 {
1081 	int i;
1082 
1083 	if (*doprint) {
1084 		log_message(MSG_DEBUG, "\n    ");
1085 		for (i = 0; i < level; i++)
1086 			log_message(MSG_DEBUG, "    ");
1087 		*doprint = 0;
1088 	}
1089 }
1090 
1091 #define	BI_QUOTE	1
1092 #define	BI_BLIT		2
1093 #define	BI_BDO		3
1094 #define	BI_QDO		4
1095 #define	BI_BR		5
1096 #define	BI_QBR		6
1097 #define	BI_BOF		7
1098 #define	BI_LOOP		8
1099 #define	BI_PLOOP	9
1100 #define	BI_TO		10
1101 #define	BI_SEMI		11
1102 #define	BI_COLON	12
1103 #define	BI_NOOP		13
1104 #define	BI_NOTYET	14	/* unimplented in "see" */
1105 
1106 struct bitab bitab[] = {
1107 	(token_t)(&quote_ptr),			"\"",		BI_QUOTE,
1108 	(token_t)(&blit_ptr),			"blit",		BI_BLIT,
1109 	(token_t)(&do_bdo_ptr),			"do",		BI_BDO,
1110 	(token_t)(&do_bqdo_ptr),		"?do",		BI_QDO,
1111 	(token_t)(&bbranch_ptrs[0]),		"br",		BI_BR,
1112 	(token_t)(&bbranch_ptrs[1]),		"qbr",		BI_QBR,
1113 	(token_t)(&bbranch_ptrs[2]),		"bof",		BI_BOF,
1114 	(token_t)(&do_loop_ptr),		"loop",		BI_LOOP,
1115 	(token_t)(&do_ploop_ptr),		"+loop",	BI_PLOOP,
1116 	(token_t)(&to_ptr),			"to",		BI_NOOP,
1117 	(token_t)(&semi_ptr),			";",		BI_SEMI,
1118 	(token_t)(&do_colon),			":",		BI_COLON,
1119 	(token_t)(&tlit_ptr),			"[']",		BI_NOOP,
1120 	(token_t)(&do_leave_ptr),		"leave",	BI_NOTYET,
1121 	(token_t)(&create_ptr),			"create",	BI_NOTYET,
1122 	(token_t)(&does_ptr),			"does>",	BI_NOTYET,
1123 	(token_t)(&value_defines[0][0]),	"a.@",		BI_NOTYET,
1124 	(token_t)(&value_defines[0][1]),	"a.!",		BI_NOTYET,
1125 	(token_t)(&value_defines[0][2]),	"a.nop",	BI_NOTYET,
1126 	(token_t)(&value_defines[1][0]),	"a.i@",		BI_NOTYET,
1127 	(token_t)(&value_defines[1][1]),	"a.i!",		BI_NOTYET,
1128 	(token_t)(&value_defines[1][2]),	"a.iad",	BI_NOTYET,
1129 	(token_t)(&value_defines[2][0]),	"a.defer",	BI_NOTYET,
1130 	(token_t)(&value_defines[2][1]),	"a.@",		BI_NOTYET,
1131 	(token_t)(&value_defines[2][2]),	"a.nop",	BI_NOTYET,
1132 	(token_t)(&value_defines[3][0]),	"a.defexec",	BI_NOTYET,
1133 	(token_t)(&value_defines[3][1]),	"a.iset",	BI_NOTYET,
1134 	(token_t)(&value_defines[3][2]),	"a.iad",	BI_NOTYET,
1135 	(token_t)(&value_defines[4][0]),	"a.binit",	BI_NOTYET,
1136 	(token_t)(&value_defines[4][1]),	"a.2drop",	BI_NOTYET,
1137 	(token_t)(&value_defines[4][2]),	"a.nop",	BI_NOTYET,
1138 	(token_t)(&value_defines[5][0]),	"a.ibinit",	BI_NOTYET,
1139 	(token_t)(&value_defines[5][1]),	"a.2drop",	BI_NOTYET,
1140 	(token_t)(&value_defines[5][2]),	"a.iad",	BI_NOTYET,
1141 	0
1142 };
1143 
1144 struct bitab *
1145 lookup_builtin(token_t builtin)
1146 {
1147 	int i;
1148 
1149 	for (i = 0; bitab[i].bi_ptr; i++)
1150 		if (bitab[i].bi_ptr == builtin)
1151 			return (&bitab[i]);
1152 	return (NULL);
1153 }
1154 
1155 static void
1156 paren_see(fcode_env_t *env)
1157 {
1158 	acf_t save_acf = (acf_t)POP(DS);
1159 	acf_t acf = save_acf;
1160 	int i, n, pass;
1161 	token_t brtab[30], thentab[30], brstk[30];
1162 	int nbrtab = 0, nthentab = 0, nbrstk = 0;
1163 	uchar_t *p;
1164 	int level = 0, doprintlevel = 1, nthen;
1165 	struct bitab *bip;
1166 	token_t last_lit = 0, case_lit = 0, endof_loc = 0, endcase_loc = 0;
1167 
1168 	if ((bip = lookup_builtin(*acf)) == NULL ||
1169 	    bip->bi_type != BI_COLON) {
1170 		if (bip = lookup_builtin((token_t)acf))
1171 			log_message(MSG_INFO, "%s: builtin\n", bip->bi_name);
1172 		else
1173 			log_message(MSG_INFO, "%s: builtin\n",
1174 			    acf_to_name(env, acf));
1175 		return;
1176 	}
1177 	log_message(MSG_INFO, ": %s", acf_to_name(env, acf));
1178 	for (pass = 0; pass < 2; pass++) {
1179 		acf = save_acf;
1180 		for (acf++; ; acf++) {
1181 			if (pass) {
1182 				print_level(level, &doprintlevel);
1183 				for (nthen = 0; nthentab > 0 &&
1184 				    thentab[nthentab-1] == (token_t)acf;
1185 				    nthentab--)
1186 					nthen++;
1187 				if (nthen) {
1188 					level -= nthen;
1189 					doprintlevel = 1;
1190 					print_level(level, &doprintlevel);
1191 					for (i = 0; i < nthen; i++)
1192 						log_message(MSG_INFO, "then ");
1193 				}
1194 				print_level(level, &doprintlevel);
1195 				for (i = 0; i < nbrtab; i += 2)
1196 					if ((token_t)acf == brtab[i]) {
1197 						log_message(MSG_INFO, "begin ");
1198 						brstk[nbrstk++] = brtab[i+1];
1199 						level++;
1200 						doprintlevel = 1;
1201 					}
1202 				print_level(level, &doprintlevel);
1203 				if (case_lit == (token_t)acf) {
1204 					log_message(MSG_INFO, "case ");
1205 					doprintlevel = 1;
1206 					print_level(level, &doprintlevel);
1207 				}
1208 				if (endof_loc == (token_t)acf) {
1209 					log_message(MSG_INFO, "endof ");
1210 					doprintlevel = 1;
1211 					print_level(level, &doprintlevel);
1212 				}
1213 				if (endcase_loc == (token_t)acf) {
1214 					doprintlevel = 1;
1215 					print_level(level, &doprintlevel);
1216 					log_message(MSG_INFO, "endcase ");
1217 				}
1218 			}
1219 			if ((bip = lookup_builtin((token_t)*acf)) == 0) {
1220 				last_lit = (token_t)acf;
1221 				if (pass)
1222 					log_message(MSG_INFO, "%s ",
1223 					    acf_to_name(env, (acf_t)*acf));
1224 				continue;
1225 			}
1226 			if (bip->bi_type == BI_SEMI) {
1227 				if (pass) {
1228 					log_message(MSG_INFO, "\n");
1229 					log_message(MSG_INFO, "%s\n",
1230 					    bip->bi_name);
1231 				}
1232 				break;
1233 			}
1234 			switch (bip->bi_type) {
1235 
1236 			case BI_NOOP:
1237 			case BI_NOTYET:
1238 				if (pass)
1239 					log_message(MSG_INFO, "%s ",
1240 					    bip->bi_name);
1241 				break;
1242 
1243 			case BI_QUOTE:
1244 				if (pass)
1245 					log_message(MSG_INFO, "\" ");
1246 				acf++;
1247 				p = (uchar_t *)acf;
1248 				n = *p++;
1249 				if (pass)
1250 					log_message(MSG_INFO, "%s\" ", p);
1251 				p += n + 1;
1252 				for (; ((token_t)(p)) & (sizeof (token_t) - 1);
1253 				    p++)
1254 					;
1255 				acf = (acf_t)p;
1256 				acf--;
1257 				break;
1258 
1259 			case BI_BLIT:
1260 				acf++;
1261 				if (pass)
1262 					log_message(MSG_INFO, "%x ", *acf);
1263 				break;
1264 
1265 			case BI_BDO:
1266 			case BI_QDO:
1267 				if (pass) {
1268 					log_message(MSG_INFO, "%s ",
1269 					    bip->bi_name);
1270 					doprintlevel = 1;
1271 					level++;
1272 				}
1273 				acf++;
1274 				break;
1275 
1276 			case BI_BR:
1277 				acf++;
1278 				if (pass) {
1279 					if (*acf < (token_t)acf) {
1280 						if (nbrstk) {
1281 							doprintlevel = 1;
1282 							level--;
1283 							print_level(level,
1284 							    &doprintlevel);
1285 							log_message(MSG_INFO,
1286 							    "repeat ");
1287 							nbrstk--;
1288 						} else
1289 							log_message(MSG_INFO,
1290 							    "[br back?]");
1291 					} else if (nthentab) {
1292 						doprintlevel = 1;
1293 						print_level(level - 1,
1294 						    &doprintlevel);
1295 						log_message(MSG_INFO, "else ");
1296 						doprintlevel = 1;
1297 						thentab[nthentab - 1] = *acf;
1298 					}
1299 				} else {
1300 					if (*acf < (token_t)acf) {
1301 						brtab[nbrtab++] = *acf;
1302 						brtab[nbrtab++] = (token_t)acf;
1303 					}
1304 					if (endcase_loc == 0 &&
1305 					    case_lit) {
1306 						endcase_loc = *acf;
1307 					}
1308 				}
1309 				break;
1310 
1311 			case BI_QBR:
1312 				acf++;
1313 				if (pass) {
1314 					if (*acf < (token_t)acf) {
1315 						if (nbrstk) {
1316 							doprintlevel = 1;
1317 							level--;
1318 							print_level(level,
1319 							    &doprintlevel);
1320 							log_message(MSG_INFO,
1321 							    "until ");
1322 							nbrstk--;
1323 						} else
1324 							log_message(MSG_INFO,
1325 							    "[br back?]");
1326 					} else if (nbrstk > 0 &&
1327 					    *acf >= brstk[nbrstk - 1]) {
1328 						doprintlevel = 1;
1329 						print_level(level - 1,
1330 						    &doprintlevel);
1331 						log_message(MSG_INFO,
1332 						    "while ");
1333 						doprintlevel = 1;
1334 					} else {
1335 						log_message(MSG_INFO, "if ");
1336 						doprintlevel = 1;
1337 						level++;
1338 						thentab[nthentab++] = *acf;
1339 					}
1340 				} else if (*acf < (token_t)acf) {
1341 					brtab[nbrtab++] = *acf;
1342 					brtab[nbrtab++] = (token_t)acf;
1343 				}
1344 				break;
1345 
1346 			case BI_BOF:
1347 				acf++;
1348 				if (pass) {
1349 					log_message(MSG_INFO, "of ");
1350 					endof_loc = *acf;
1351 				} else if (case_lit == 0) {
1352 					case_lit = last_lit;
1353 				}
1354 				break;
1355 
1356 			case BI_LOOP:
1357 			case BI_PLOOP:
1358 				if (pass) {
1359 					level--;
1360 					doprintlevel = 1;
1361 					print_level(level, &doprintlevel);
1362 					log_message(MSG_INFO, "%s ",
1363 					    bip->bi_name);
1364 				}
1365 				acf++;
1366 				break;
1367 
1368 			default:
1369 				log_message(MSG_ERROR, "Invalid builtin %s\n",
1370 				    bip->bi_name);
1371 			}
1372 		}
1373 	}
1374 }
1375 
1376 static void
1377 see(fcode_env_t *env)
1378 {
1379 	fstack_t d;
1380 
1381 	parse_word(env);
1382 	dollar_find(env);
1383 	d = POP(DS);
1384 	if (d)
1385 		paren_see(env);
1386 	else {
1387 		log_message(MSG_WARN, "?");
1388 		two_drop(env);
1389 	}
1390 }
1391 
1392 static acf_t
1393 do_dot_calls(fcode_env_t *env, acf_t acf, void *cacf)
1394 {
1395 	token_t *dptr = ACF_TO_LINK(acf);
1396 	token_t *wptr = acf;
1397 
1398 	if (*wptr == (token_t)(&do_colon)) {
1399 		do {
1400 			if ((acf_t)(*wptr) == (acf_t)cacf)
1401 				output_acf_name(acf);
1402 		} while (*wptr++ != (token_t)(&semi_ptr));
1403 	} else if ((acf_t)(*wptr) == cacf)
1404 		output_acf_name(acf);
1405 	else if (wptr == (token_t *)cacf)
1406 		output_acf_name(acf);
1407 	return (NULL);
1408 }
1409 
1410 static void
1411 dot_calls(fcode_env_t *env)
1412 {
1413 	acf_t acf = (acf_t)POP(DS);
1414 
1415 	search_all_dictionaries(env, do_dot_calls, acf);
1416 	output_acf_name(NULL);
1417 }
1418 
1419 static void
1420 dot_pci_space(fcode_env_t *env)
1421 {
1422 	fstack_t d = POP(DS);
1423 
1424 	switch ((d >> 24) & 0x3) {
1425 	case 0: log_message(MSG_INFO, "Config,"); break;
1426 	case 1: log_message(MSG_INFO, "IO,"); break;
1427 	case 2: log_message(MSG_INFO, "Memory32,"); break;
1428 	case 3: log_message(MSG_INFO, "Memory64,"); break;
1429 	}
1430 	if (d & 0x80000000)
1431 		log_message(MSG_INFO, "Not_reloc,");
1432 	if (d & 0x400000000)
1433 		log_message(MSG_INFO, "Prefetch,");
1434 	if (d & 0x200000000)
1435 		log_message(MSG_INFO, "Alias,");
1436 	log_message(MSG_INFO, "Bus%d,", (d >> 16) & 0xff);
1437 	log_message(MSG_INFO, "Dev%d,", (d >> 11) & 0x1f);
1438 	log_message(MSG_INFO, "Func%d,", (d >> 8) & 0x7);
1439 	log_message(MSG_INFO, "Reg%x", d & 0xff);
1440 	log_message(MSG_INFO, "\n");
1441 }
1442 
1443 void
1444 fcode_debug(fcode_env_t *env)
1445 {
1446 	PUSH(DS, (fstack_t)(&env->fcode_debug));
1447 }
1448 
1449 static void
1450 base_addr(fcode_env_t *env)
1451 {
1452 	PUSH(DS, (fstack_t)env->base);
1453 }
1454 
1455 static int mw_valid;
1456 static int mw_size;
1457 static void *mw_addr;
1458 static fstack_t mw_value;
1459 static fstack_t mw_lastvalue;
1460 
1461 static fstack_t
1462 mw_fetch(void)
1463 {
1464 	switch (mw_size) {
1465 	case 1: return (*((uint8_t *)mw_addr));
1466 	case 2: return (*((uint16_t *)mw_addr));
1467 	case 4: return (*((uint32_t *)mw_addr));
1468 	case 8: return (*((uint64_t *)mw_addr));
1469 	}
1470 	return (0);
1471 }
1472 
1473 void
1474 do_memory_watch(fcode_env_t *env)
1475 {
1476 	fstack_t value;
1477 
1478 	if (!mw_valid)
1479 		return;
1480 	value = mw_fetch();
1481 	if (value != mw_lastvalue) {
1482 		if (mw_valid == 1 || mw_value == value) {
1483 			log_message(MSG_INFO,
1484 			    "memory-watch: %p/%d: %llx -> %llx\n",
1485 			    mw_addr, mw_size, (uint64_t)mw_lastvalue,
1486 			    (uint64_t)value);
1487 			do_fclib_step(env);
1488 		}
1489 		mw_lastvalue = value;
1490 	}
1491 }
1492 
1493 static void
1494 set_memory_watch(fcode_env_t *env, int type, int size, void *addr,
1495     fstack_t value)
1496 {
1497 	switch (size) {
1498 	case 1: case 2: case 4: case 8:
1499 		break;
1500 	default:
1501 		log_message(MSG_ERROR, "set_memory_watch: invalid size: %d\n",
1502 		    size);
1503 		return;
1504 	}
1505 	mw_valid = type;
1506 	mw_size = size;
1507 	mw_addr = addr;
1508 	mw_value = value;
1509 	mw_lastvalue = mw_fetch();
1510 }
1511 
1512 static void
1513 memory_watch(fcode_env_t *env)
1514 {
1515 	int size = POP(DS);
1516 	void *addr = (void *)POP(DS);
1517 
1518 	set_memory_watch(env, 1, size, addr, 0);
1519 }
1520 
1521 static void
1522 memory_watch_value(fcode_env_t *env)
1523 {
1524 	int size = POP(DS);
1525 	void *addr = (void *)POP(DS);
1526 	fstack_t value = POP(DS);
1527 
1528 	set_memory_watch(env, 2, size, addr, value);
1529 }
1530 
1531 static void
1532 memory_watch_clear(fcode_env_t *env)
1533 {
1534 	mw_valid = 0;
1535 }
1536 
1537 static void
1538 vsearch(fcode_env_t *env)
1539 {
1540 	fstack_t value;
1541 	int size = POP(DS);
1542 	fstack_t match_value = POP(DS);
1543 	uchar_t *toaddr = (uchar_t *)POP(DS);
1544 	uchar_t *fromaddr = (uchar_t *)POP(DS);
1545 
1546 	log_message(MSG_INFO, "%p to %p by %d looking for %llx\n", fromaddr,
1547 	    toaddr, size, (uint64_t)match_value);
1548 	for (; fromaddr < toaddr; fromaddr += size) {
1549 		switch (size) {
1550 		case 1: value = *((uint8_t *)fromaddr); break;
1551 		case 2: value = *((uint16_t *)fromaddr); break;
1552 		case 4: value = *((uint32_t *)fromaddr); break;
1553 		case 8: value = *((uint64_t *)fromaddr); break;
1554 		default:
1555 			log_message(MSG_INFO, "Invalid size: %d\n", size);
1556 			return;
1557 		}
1558 		if (value == match_value)
1559 			log_message(MSG_INFO, "%p\n", fromaddr);
1560 	}
1561 }
1562 
1563 #pragma init(_init)
1564 
1565 static void
1566 _init(void)
1567 {
1568 	fcode_env_t *env = initial_env;
1569 
1570 	ASSERT(env);
1571 	NOTICE;
1572 
1573 	FORTH(IMMEDIATE,	"words",		words);
1574 	FORTH(IMMEDIATE,	"dump-words",		dump_words);
1575 	FORTH(IMMEDIATE,	"dump-dict",		dump_dictionary);
1576 	FORTH(IMMEDIATE,	"dump-table",		dump_table);
1577 	FORTH(0,		"debugf",		debugf);
1578 	FORTH(0,		".debugf",		dot_debugf);
1579 	FORTH(0,		"set-debugf",		set_debugf);
1580 	FORTH(0,		"debugf?",		debugf_qmark);
1581 	FORTH(0,		"control",		control);
1582 	FORTH(0,		"dump",			dump);
1583 	FORTH(IMMEDIATE,	"showstack",		show_stack);
1584 	FORTH(IMMEDIATE,	"sifting",		sifting);
1585 	FORTH(IMMEDIATE,	"ctrace",		ctrace);
1586 	FORTH(IMMEDIATE,	"ftrace",		ftrace);
1587 	FORTH(0,		"see",			see);
1588 	FORTH(0,		"(see)",		paren_see);
1589 	FORTH(0,		"base-addr",		base_addr);
1590 	FORTH(0,		"smatch",		smatch);
1591 	FORTH(0,		".calls",		dot_calls);
1592 	FORTH(0,		".pci-space",		dot_pci_space);
1593 	FORTH(0,		"(debug)",		paren_debug);
1594 	FORTH(0,		"debug",		debug);
1595 	FORTH(0,		".debug",		dot_debug);
1596 	FORTH(0,		"undebug",		undebug);
1597 	FORTH(0,		"memory-watch",		memory_watch);
1598 	FORTH(0,		"memory-watch-value",	memory_watch_value);
1599 	FORTH(0,		"memory-watch-clear",	memory_watch_clear);
1600 	FORTH(0,		"vsearch",		vsearch);
1601 }
1602