dmake: do not set MAKEFLAGS=k
[unleashed/tickless.git] / usr / src / lib / efcode / engine / debug.c
blobbbc32ebdf54ad25538887b8daaf2828acaf18383
1 /*
2 * CDDL HEADER START
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.
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.
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]
20 * CDDL HEADER END
23 * Copyright 2005 Sun Microsystems, Inc. All rights reserved.
24 * Use is subject to license terms.
27 #pragma ident "%Z%%M% %I% %E% SMI"
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>
37 #include <fcode/private.h>
38 #include <fcode/log.h>
40 #ifndef DEBUG_LVL
41 #define DEBUG_LVL 0
42 #endif
44 struct bitab {
45 token_t bi_ptr;
46 char *bi_name;
47 int bi_type;
50 struct bitab *lookup_builtin(token_t);
52 static int debug_level = DEBUG_LVL;
54 void
55 set_interpreter_debug_level(long lvl)
57 debug_level = lvl;
60 long
61 get_interpreter_debug_level(void)
63 return (debug_level);
66 void
67 output_data_stack(fcode_env_t *env, int msglevel)
69 int i;
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, ") ");
81 void
82 output_return_stack(fcode_env_t *env, int show_wa, int msglevel)
84 int i;
85 int anyout = 0;
87 log_message(msglevel, "R:( ");
88 if (show_wa) {
89 log_message(msglevel, "%s ",
90 acf_backup_search(env, (acf_t)WA));
91 anyout++;
93 if (IP) {
94 anyout++;
95 log_message(msglevel, "%s ", acf_backup_search(env, IP));
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]));
102 if (!anyout)
103 log_message(msglevel, "<empty> ");
104 log_message(msglevel, ") ");
107 void
108 dump_comma(fcode_env_t *env, char *type)
110 xforth_t d;
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);
119 static int ndebug_names;
120 #define MAXDEBUG_NAMES 10
121 static char *debug_names[MAXDEBUG_NAMES];
123 static int ndebug_acfs;
124 #define MAXDEBUG_ACFS 10
125 static acf_t debug_acfs[MAXDEBUG_ACFS];
127 void
128 add_debug_acf(fcode_env_t *env, acf_t acf)
130 int i;
132 for (i = 0; i < ndebug_acfs; i++)
133 if (acf == debug_acfs[i])
134 return;
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;
146 static void
147 paren_debug(fcode_env_t *env)
149 acf_t acf;
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;
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;
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;
167 add_debug_acf(env, acf);
170 static void
171 debug(fcode_env_t *env)
173 fstack_t d;
174 char *word;
175 acf_t acf;
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;
194 * Eliminate dups and add vocabulary forth to end if not already on list.
196 static void
197 order_to_dict_list(fcode_env_t *env, token_t *order[])
199 int i, j, norder = 0;
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++)
206 if (j == norder)
207 order[norder++] = env->order[i];
209 for (j = 0; j < norder && order[j] != (token_t *)&env->forth_voc_link;
210 j++)
212 if (j == norder)
213 order[norder++] = (token_t *)&env->forth_voc_link;
214 order[norder] = NULL;
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)
222 token_t *order[MAX_ORDER+1];
223 int i;
224 token_t *dptr;
225 acf_t acf;
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);
234 return (NULL);
237 char *
238 acf_to_str(acf_t acf)
240 static char msg[(sizeof (acf) * 2) + 3];
242 sprintf(msg, "(%08p)", acf);
243 return (msg);
246 char *
247 get_name_or_acf(token_t *dptr)
249 char *name;
251 if ((name = get_name(dptr)) != NULL)
252 return (name);
253 return (acf_to_str(LINK_TO_ACF(dptr)));
256 static void
257 output_acf_name(acf_t acf)
259 char *name;
260 token_t *dptr;
261 static int acf_count = 0;
263 if (acf == NULL) {
264 if (acf_count)
265 log_message(MSG_INFO, "\n");
266 acf_count = 0;
267 return;
269 dptr = ACF_TO_LINK(acf);
270 if ((name = get_name(dptr)) == NULL)
271 name = "<noname>";
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, " ");
281 static void
282 dot_debug(fcode_env_t *env)
284 int i;
285 token_t *dptr;
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]);
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])));
302 static void
303 do_undebug(fcode_env_t *env, char *name)
305 int i;
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;
320 static void
321 undebug(fcode_env_t *env)
323 fstack_t d;
324 acf_t acf;
325 flag_t *flagp;
326 char *name;
327 int i, j;
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;
350 } else
351 two_drop(env);
352 name = pop_a_string(env, NULL);
353 do_undebug(env, name);
357 name_is_debugged(fcode_env_t *env, char *name)
359 int i;
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);
370 * This is complicated by being given ACF's to temporary compile words which
371 * don't have a header.
374 is_debug_word(fcode_env_t *env, acf_t acf)
376 flag_t *flagp;
377 int i;
379 /* check to see if any words are being debugged */
380 if (ndebug_acfs == 0)
381 return (0);
383 /* only words in dictionary can be debugged */
384 if (!within_dictionary(env, acf))
385 return (0);
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);
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);
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;
405 void
406 debug_set_level(fcode_env_t *env, int level)
408 debug_curr_level[ndebug_stack - 1] = level;
409 set_interpreter_debug_level(level);
412 token_t
413 find_semi_in_colon_def(fcode_env_t *env, acf_t acf)
415 for (; within_dictionary(env, acf); acf++)
416 if (*acf == (token_t)(&semi_ptr))
417 return ((token_t)acf);
418 return (0);
421 void
422 check_for_debug_entry(fcode_env_t *env)
424 int top;
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... */
436 debug_set_level(env, DEBUG_STEPPING);
437 output_step_message(env);
441 void
442 check_for_debug_exit(fcode_env_t *env)
444 if (ndebug_stack) {
445 int top = ndebug_stack - 1;
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]);
459 void
460 check_semi_debug_exit(fcode_env_t *env)
462 if (ndebug_stack) {
463 int top = ndebug_stack - 1;
465 if ((token_t)(IP - 1) == debug_high[top]) {
466 set_interpreter_debug_level(debug_prev_level[top]);
467 ndebug_stack--;
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.
477 current_debug_state(fcode_env_t *env)
479 if (ndebug_stack) {
480 int top = ndebug_stack - 1;
481 set_interpreter_debug_level(debug_prev_level[top]);
483 return (ndebug_stack);
486 void
487 clear_debug_state(fcode_env_t *env, int oldstate)
489 if (ndebug_stack && oldstate <= ndebug_stack) {
490 set_interpreter_debug_level(debug_prev_level[oldstate]);
491 ndebug_stack = oldstate;
495 void
496 unbug(fcode_env_t *env)
498 int i;
499 token_t *link;
500 flag_t *flag;
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;
507 clear_debug_state(env, 0);
510 void
511 output_vitals(fcode_env_t *env)
513 log_message(MSG_FC_DEBUG, "IP=%p, *IP=%p, WA=%p, *WA=%p ", IP,
514 (IP ? *IP : 0), WA, (WA ? *WA : 0));
518 do_exec_debug(fcode_env_t *env, void *fn)
520 int dl = debug_level;
521 int show_wa = 1;
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);
528 if (dl & DEBUG_STEPPING) {
529 dl |= DEBUG_EXEC_DUMP_DS;
531 if (dl & (DEBUG_STEPPING | DEBUG_EXEC_TRACE)) {
532 log_message(MSG_FC_DEBUG, "%-15s ", acf_to_name(env, WA));
533 show_wa = 0;
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);
549 static void
550 smatch(fcode_env_t *env)
552 int len;
553 char *str, *p;
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);
564 void
565 check_vitals(fcode_env_t *env)
567 int i;
568 token_t *dptr;
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);
582 if (HERE < env->base || HERE >= env->base + dict_size) {
583 log_message(MSG_ERROR, "HERE: %p outside range\n", HERE);
585 if (DS < env->ds0 || DS >= &env->ds0[stack_size]) {
586 forth_abort(env, "DS: %p outside range\n", DS);
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;
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);
599 static void
600 dump_table(fcode_env_t *env)
602 int i;
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));
611 log_message(MSG_DEBUG, "%d FCODES implemented\n", fcode_impl_count);
614 void
615 verify_usage(fcode_env_t *env)
617 int i, untested = 0;
619 for (i = 0; i < MAX_FCODE; i++) {
620 int verify;
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++;
635 if (untested)
636 log_message(MSG_DEBUG, "%d untested tokens\n", untested);
639 static void
640 debugf(fcode_env_t *env)
642 PUSH(DS, (fstack_t)&debug_level);
645 static void
646 control(fcode_env_t *env)
648 PUSH(DS, (fstack_t)&env->control);
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",
689 void
690 debug_flags_to_output(fcode_env_t *env, int flags)
692 int first = 1, i;
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);
701 if (first)
702 log_message(MSG_INFO, "<empty>");
703 log_message(MSG_INFO, "\n");
706 static void
707 dot_debugf(fcode_env_t *env)
709 debug_flags_to_output(env, debug_level);
712 static void
713 debugf_qmark(fcode_env_t *env)
715 debug_flags_to_output(env, 0xffffffff);
719 debug_flags_to_mask(char *str)
721 int flags = 0;
722 char *p;
723 int i;
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);
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;
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);
755 return (flags);
758 static void
759 set_debugf(fcode_env_t *env)
761 char *str;
763 str = parse_a_string(env, NULL);
764 debug_level = debug_flags_to_mask(str);
767 static acf_t
768 show_a_word(fcode_env_t *env, acf_t acf, void *arg)
770 static int nshow_words = 0;
772 if (acf == NULL) {
773 if (nshow_words > 0) {
774 log_message(MSG_DEBUG, "\n");
775 nshow_words = 0;
777 return (NULL);
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;
785 return (NULL);
788 void
789 words(fcode_env_t *env)
791 (void) search_all_dictionaries(env, show_a_word, NULL);
792 (void) show_a_word(env, NULL, NULL);
795 static acf_t
796 dump_a_word(fcode_env_t *env, acf_t acf, void *arg)
798 output_acf_name(acf);
799 return (NULL);
802 void
803 dump_words(fcode_env_t *env)
805 (void) search_all_dictionaries(env, dump_a_word, NULL);
806 output_acf_name(NULL);
809 static void
810 dump_line(uchar_t *ptr)
812 uchar_t *byte;
813 int i;
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++);
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);
826 log_message(MSG_INFO, "\n");
829 void
830 dump_dictionary(fcode_env_t *env)
832 uchar_t *ptr;
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);
840 static char *
841 acf_to_fcode_name(fcode_env_t *env, acf_t acf)
843 int i;
845 for (i = 0; i < MAX_FCODE; i++)
846 if (env->table[i].apf == acf)
847 return (env->table[i].name);
848 return (NULL);
851 static acf_t
852 acf_match(fcode_env_t *env, acf_t sacf, void *macf)
854 if (sacf == (acf_t)macf)
855 return (sacf);
856 return (NULL);
860 * Given an ACF, return ptr to name or "unknown" string.
862 char *
863 acf_to_name(fcode_env_t *env, acf_t acf)
865 struct bitab *bip;
866 static char name_buf[256];
867 uchar_t *p, *np;
868 int i, n;
870 if (!within_dictionary(env, acf)) {
871 if ((bip = lookup_builtin((token_t)acf)) != NULL)
872 return (bip->bi_name);
873 return (NULL);
875 return (get_name_or_acf(ACF_TO_LINK(acf)));
879 within_dictionary(fcode_env_t *env, void *addr)
881 return ((uchar_t *)addr >= env->base &&
882 (uchar_t *)addr < env->base + dict_size);
885 static int
886 within_word(fcode_env_t *env, acf_t acf, acf_t wacf)
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));
896 return (0);
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?).
904 char *
905 acf_backup_search(fcode_env_t *env, acf_t acf)
907 acf_t nacf;
908 char *name;
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);
919 return (acf_to_str(acf));
923 * Print out current process's C stack using /usr/proc/bin/pstack
925 void
926 ctrace(fcode_env_t *env)
928 char buf[256];
929 FILE *fd;
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);
943 * Dump data, return stacks, try to unthread forth calling stack.
945 void
946 ftrace(fcode_env_t *env)
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");
954 int in_forth_abort;
957 * Handle fatal error, if interactive mode, return to ok prompt.
959 void
960 forth_abort(fcode_env_t *env, char *fmt, ...)
962 va_list ap;
963 char msg[256];
965 if (in_forth_abort) {
966 log_message(MSG_FATAL, "ABORT: abort within forth_abort\n");
967 abort();
969 in_forth_abort++;
971 va_start(ap, fmt);
972 vsprintf(msg, fmt, ap);
973 log_message(MSG_ERROR, "ABORT: %s\n", msg);
975 if (env) {
976 ctrace(env);
977 ftrace(env);
980 return_to_interact(env);
982 * If not in interactive mode, return_to_interact just returns.
984 exit(1);
988 * Handle fatal system call error
990 void
991 forth_perror(fcode_env_t *env, char *fmt, ...)
993 va_list ap;
994 char msg[256];
995 int save_errno = errno; /* just in case... */
997 va_start(ap, fmt);
998 vsprintf(msg, fmt, ap);
1000 forth_abort(env, "%s: %s", msg, strerror(save_errno));
1003 static void
1004 show_stack(fcode_env_t *env)
1006 #ifdef DEBUG
1007 debug_level ^= DEBUG_SHOW_STACK;
1008 #else
1009 /*EMPTY*/
1010 #endif
1013 static void
1014 print_bytes_header(int width, int offset)
1016 int i;
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);
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);
1036 log_message(MSG_INFO, "\n");
1039 static void
1040 dump(fcode_env_t *env)
1042 uchar_t *data;
1043 int len, offset;
1044 char buf[20];
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);
1057 static acf_t
1058 do_sifting(fcode_env_t *env, acf_t acf, void *pat)
1060 char *name;
1062 if ((name = get_name(ACF_TO_LINK(acf))) != NULL && strstr(name, pat))
1063 output_acf_name(acf);
1064 return (NULL);
1067 static void
1068 sifting(fcode_env_t *env)
1070 char *pat;
1072 if ((pat = parse_a_string(env, NULL)) != NULL) {
1073 (void) search_all_dictionaries(env, do_sifting, pat);
1074 output_acf_name(NULL);
1078 void
1079 print_level(int level, int *doprint)
1081 int i;
1083 if (*doprint) {
1084 log_message(MSG_DEBUG, "\n ");
1085 for (i = 0; i < level; i++)
1086 log_message(MSG_DEBUG, " ");
1087 *doprint = 0;
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" */
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,
1144 struct bitab *
1145 lookup_builtin(token_t builtin)
1147 int i;
1149 for (i = 0; bitab[i].bi_ptr; i++)
1150 if (bitab[i].bi_ptr == builtin)
1151 return (&bitab[i]);
1152 return (NULL);
1155 static void
1156 paren_see(fcode_env_t *env)
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;
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;
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 ");
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;
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);
1208 if (endof_loc == (token_t)acf) {
1209 log_message(MSG_INFO, "endof ");
1210 doprintlevel = 1;
1211 print_level(level, &doprintlevel);
1213 if (endcase_loc == (token_t)acf) {
1214 doprintlevel = 1;
1215 print_level(level, &doprintlevel);
1216 log_message(MSG_INFO, "endcase ");
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;
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);
1232 break;
1234 switch (bip->bi_type) {
1236 case BI_NOOP:
1237 case BI_NOTYET:
1238 if (pass)
1239 log_message(MSG_INFO, "%s ",
1240 bip->bi_name);
1241 break;
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++)
1255 acf = (acf_t)p;
1256 acf--;
1257 break;
1259 case BI_BLIT:
1260 acf++;
1261 if (pass)
1262 log_message(MSG_INFO, "%x ", *acf);
1263 break;
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++;
1273 acf++;
1274 break;
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;
1299 } else {
1300 if (*acf < (token_t)acf) {
1301 brtab[nbrtab++] = *acf;
1302 brtab[nbrtab++] = (token_t)acf;
1304 if (endcase_loc == 0 &&
1305 case_lit) {
1306 endcase_loc = *acf;
1309 break;
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;
1340 } else if (*acf < (token_t)acf) {
1341 brtab[nbrtab++] = *acf;
1342 brtab[nbrtab++] = (token_t)acf;
1344 break;
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;
1354 break;
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);
1365 acf++;
1366 break;
1368 default:
1369 log_message(MSG_ERROR, "Invalid builtin %s\n",
1370 bip->bi_name);
1376 static void
1377 see(fcode_env_t *env)
1379 fstack_t d;
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);
1392 static acf_t
1393 do_dot_calls(fcode_env_t *env, acf_t acf, void *cacf)
1395 token_t *dptr = ACF_TO_LINK(acf);
1396 token_t *wptr = acf;
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);
1410 static void
1411 dot_calls(fcode_env_t *env)
1413 acf_t acf = (acf_t)POP(DS);
1415 search_all_dictionaries(env, do_dot_calls, acf);
1416 output_acf_name(NULL);
1419 static void
1420 dot_pci_space(fcode_env_t *env)
1422 fstack_t d = POP(DS);
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;
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");
1443 void
1444 fcode_debug(fcode_env_t *env)
1446 PUSH(DS, (fstack_t)(&env->fcode_debug));
1449 static void
1450 base_addr(fcode_env_t *env)
1452 PUSH(DS, (fstack_t)env->base);
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;
1461 static fstack_t
1462 mw_fetch(void)
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));
1470 return (0);
1473 void
1474 do_memory_watch(fcode_env_t *env)
1476 fstack_t value;
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);
1489 mw_lastvalue = value;
1493 static void
1494 set_memory_watch(fcode_env_t *env, int type, int size, void *addr,
1495 fstack_t value)
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;
1505 mw_valid = type;
1506 mw_size = size;
1507 mw_addr = addr;
1508 mw_value = value;
1509 mw_lastvalue = mw_fetch();
1512 static void
1513 memory_watch(fcode_env_t *env)
1515 int size = POP(DS);
1516 void *addr = (void *)POP(DS);
1518 set_memory_watch(env, 1, size, addr, 0);
1521 static void
1522 memory_watch_value(fcode_env_t *env)
1524 int size = POP(DS);
1525 void *addr = (void *)POP(DS);
1526 fstack_t value = POP(DS);
1528 set_memory_watch(env, 2, size, addr, value);
1531 static void
1532 memory_watch_clear(fcode_env_t *env)
1534 mw_valid = 0;
1537 static void
1538 vsearch(fcode_env_t *env)
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);
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;
1558 if (value == match_value)
1559 log_message(MSG_INFO, "%p\n", fromaddr);
1563 #pragma init(_init)
1565 static void
1566 _init(void)
1568 fcode_env_t *env = initial_env;
1570 ASSERT(env);
1571 NOTICE;
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);