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
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]
23 * Copyright 2005 Sun Microsystems, Inc. All rights reserved.
24 * Use is subject to license terms.
27 #pragma ident "%Z%%M% %I% %E% SMI"
37 #include <fcode/private.h>
38 #include <fcode/log.h>
50 struct bitab
*lookup_builtin(token_t
);
52 static int debug_level
= DEBUG_LVL
;
55 set_interpreter_debug_level(long lvl
)
61 get_interpreter_debug_level(void)
67 output_data_stack(fcode_env_t
*env
, int msglevel
)
71 log_message(msglevel
, "( ");
73 for (i
= 0; i
< (DS
- env
->ds0
); i
++)
74 log_message(msglevel
, "%llx ",
75 (uint64_t)(env
->ds0
[i
+ 1]));
77 log_message(msglevel
, "<empty> ");
78 log_message(msglevel
, ") ");
82 output_return_stack(fcode_env_t
*env
, int show_wa
, int msglevel
)
87 log_message(msglevel
, "R:( ");
89 log_message(msglevel
, "%s ",
90 acf_backup_search(env
, (acf_t
)WA
));
95 log_message(msglevel
, "%s ", acf_backup_search(env
, IP
));
97 for (i
= (RS
- env
->rs0
) - 1; i
> 0; i
--) {
99 log_message(msglevel
, "%s ",
100 acf_backup_search(env
, (acf_t
)env
->rs0
[i
+1]));
103 log_message(msglevel
, "<empty> ");
104 log_message(msglevel
, ") ");
108 dump_comma(fcode_env_t
*env
, char *type
)
112 if (strcmp(type
, "x,") == 0)
113 d
= peek_xforth(env
);
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
];
128 add_debug_acf(fcode_env_t
*env
, acf_t acf
)
132 for (i
= 0; i
< ndebug_acfs
; i
++)
133 if (acf
== debug_acfs
[i
])
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");
141 debug_acfs
[ndebug_acfs
++] = acf
;
142 *LINK_TO_FLAGS(ACF_TO_LINK(acf
)) |= FLAG_DEBUG
;
147 paren_debug(fcode_env_t
*env
)
151 acf
= (acf_t
)POP(DS
);
152 if (!within_dictionary(env
, acf
)) {
153 log_message(MSG_INFO
, "acf: %llx not in dictionary\n",
157 if ((acf_t
)_ALIGN(acf
, token_t
) != acf
) {
158 log_message(MSG_INFO
, "acf: %llx not aligned\n",
162 if (*acf
!= (token_t
)(&do_colon
)) {
163 log_message(MSG_INFO
, "acf: %llx not a colon-def\n",
167 add_debug_acf(env
, acf
);
171 debug(fcode_env_t
*env
)
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");
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.
197 order_to_dict_list(fcode_env_t
*env
, token_t
*order
[])
199 int i
, j
, norder
= 0;
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
++)
207 order
[norder
++] = env
->order
[i
];
209 for (j
= 0; j
< norder
&& order
[j
] != (token_t
*)&env
->forth_voc_link
;
213 order
[norder
++] = (token_t
*)&env
->forth_voc_link
;
214 order
[norder
] = NULL
;
218 search_all_dictionaries(fcode_env_t
*env
,
219 acf_t (*fn
)(fcode_env_t
*, acf_t
, void *),
222 token_t
*order
[MAX_ORDER
+1];
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
)
238 acf_to_str(acf_t acf
)
240 static char msg
[(sizeof (acf
) * 2) + 3];
242 sprintf(msg
, "(%08p)", acf
);
247 get_name_or_acf(token_t
*dptr
)
251 if ((name
= get_name(dptr
)) != NULL
)
253 return (acf_to_str(LINK_TO_ACF(dptr
)));
257 output_acf_name(acf_t acf
)
261 static int acf_count
= 0;
265 log_message(MSG_INFO
, "\n");
269 dptr
= ACF_TO_LINK(acf
);
270 if ((name
= get_name(dptr
)) == NULL
)
273 log_message(MSG_INFO
, "%24s (%08p)", name
, acf
);
274 if (++acf_count
>= 2) {
275 log_message(MSG_INFO
, "\n");
278 log_message(MSG_INFO
, " ");
282 dot_debug(fcode_env_t
*env
)
287 if (ndebug_names
== 0)
288 log_message(MSG_INFO
, "No forward debug words\n");
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");
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
])));
303 do_undebug(fcode_env_t
*env
, char *name
)
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",
311 FREE(debug_names
[i
]);
312 for (i
++; i
< ndebug_names
; i
++)
313 debug_names
[i
- 1] = debug_names
[i
];
321 undebug(fcode_env_t
*env
)
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");
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
];
352 name
= pop_a_string(env
, NULL
);
353 do_undebug(env
, name
);
357 name_is_debugged(fcode_env_t
*env
, char *name
)
361 if (ndebug_names
<= 0)
363 for (i
= 0; i
< ndebug_names
; i
++)
364 if (strcmp(debug_names
[i
], name
) == 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
)
379 /* check to see if any words are being debugged */
380 if (ndebug_acfs
== 0)
383 /* only words in dictionary can be debugged */
384 if (!within_dictionary(env
, acf
))
387 /* check that word has "FLAG_DEBUG" on */
388 flagp
= LINK_TO_FLAGS(ACF_TO_LINK(acf
));
389 if ((*flagp
& FLAG_DEBUG
) == 0)
392 /* look in table of debug acf's */
393 for (i
= 0; i
< ndebug_acfs
; i
++)
394 if (debug_acfs
[i
] == acf
)
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;
406 debug_set_level(fcode_env_t
*env
, int level
)
408 debug_curr_level
[ndebug_stack
- 1] = level
;
409 set_interpreter_debug_level(level
);
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
);
422 check_for_debug_entry(fcode_env_t
*env
)
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
)) {
432 find_semi_in_colon_def(env
, WA
);
434 debug_high
[top
] = 0; /* marker... */
436 debug_set_level(env
, DEBUG_STEPPING
);
437 output_step_message(env
);
442 check_for_debug_exit(fcode_env_t
*env
)
445 int top
= ndebug_stack
- 1;
447 if (debug_high
[top
] == 0) {
448 set_interpreter_debug_level(debug_prev_level
[top
]);
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
]);
454 set_interpreter_debug_level(debug_prev_level
[top
]);
460 check_semi_debug_exit(fcode_env_t
*env
)
463 int top
= ndebug_stack
- 1;
465 if ((token_t
)(IP
- 1) == debug_high
[top
]) {
466 set_interpreter_debug_level(debug_prev_level
[top
]);
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
)
480 int top
= ndebug_stack
- 1;
481 set_interpreter_debug_level(debug_prev_level
[top
]);
483 return (ndebug_stack
);
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
;
496 unbug(fcode_env_t
*env
)
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);
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
;
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)
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
));
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
)
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
));
550 smatch(fcode_env_t
*env
)
555 if ((str
= parse_a_string(env
, &len
)) == NULL
)
556 log_message(MSG_INFO
, "smatch: no string\n");
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
);
565 check_vitals(fcode_env_t
*env
)
571 if (*dptr
&& !within_dictionary(env
, (uchar_t
*)*dptr
))
572 log_message(MSG_ERROR
, "Current: %p outside dictionary\n",
574 for (i
= env
->order_depth
; i
>= 0; i
--) {
575 dptr
= env
->order
[i
];
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
);
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
);
600 dump_table(fcode_env_t
*env
)
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
);
615 verify_usage(fcode_env_t
*env
)
619 for (i
= 0; i
< MAX_FCODE
; i
++) {
622 verify
= env
->table
[i
].flags
& (ANSI_WORD
|P1275_WORD
);
625 (env
->table
[i
].usage
== 0) &&
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
));
636 log_message(MSG_DEBUG
, "%d untested tokens\n", untested
);
640 debugf(fcode_env_t
*env
)
642 PUSH(DS
, (fstack_t
)&debug_level
);
646 control(fcode_env_t
*env
)
648 PUSH(DS
, (fstack_t
)&env
->control
);
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",
690 debug_flags_to_output(fcode_env_t
*env
, int flags
)
694 for (i
= 0; bittab
[i
].b_bitval
!= 0; i
++)
695 if (bittab
[i
].b_bitval
& flags
) {
697 log_message(MSG_INFO
, ",");
699 log_message(MSG_INFO
, bittab
[i
].b_bitname
);
702 log_message(MSG_INFO
, "<empty>");
703 log_message(MSG_INFO
, "\n");
707 dot_debugf(fcode_env_t
*env
)
709 debug_flags_to_output(env
, debug_level
);
713 debugf_qmark(fcode_env_t
*env
)
715 debug_flags_to_output(env
, 0xffffffff);
719 debug_flags_to_mask(char *str
)
728 if (*str
== 'x' || *str
== 'X') {
729 sscanf(str
+ 1, "%x", &flags
);
731 sscanf(str
, "%o", &flags
);
733 sscanf(str
, "%d", &flags
);
736 if (strcmp(str
, "clear") == 0)
738 if (strcmp(str
, "all") == 0)
739 return (0xffffffff & ~DEBUG_STEPPING
);
742 if (p
= strchr(str
, ','))
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
;
749 if (bittab
[i
].b_bitname
== 0)
750 log_message(MSG_WARN
,
751 "Unknown debug flag: '%s'\n", str
);
759 set_debugf(fcode_env_t
*env
)
763 str
= parse_a_string(env
, NULL
);
764 debug_level
= debug_flags_to_mask(str
);
768 show_a_word(fcode_env_t
*env
, acf_t acf
, void *arg
)
770 static int nshow_words
= 0;
773 if (nshow_words
> 0) {
774 log_message(MSG_DEBUG
, "\n");
779 log_message(MSG_DEBUG
, "%15s ", get_name_or_acf(ACF_TO_LINK(acf
)));
781 if (nshow_words
>= 4) {
782 log_message(MSG_DEBUG
, "\n");
789 words(fcode_env_t
*env
)
791 (void) search_all_dictionaries(env
, show_a_word
, NULL
);
792 (void) show_a_word(env
, NULL
, NULL
);
796 dump_a_word(fcode_env_t
*env
, acf_t acf
, void *arg
)
798 output_acf_name(acf
);
803 dump_words(fcode_env_t
*env
)
805 (void) search_all_dictionaries(env
, dump_a_word
, NULL
);
806 output_acf_name(NULL
);
810 dump_line(uchar_t
*ptr
)
815 log_message(MSG_INFO
, "%p ", ptr
);
816 for (i
= 0, byte
= ptr
; i
< 16; i
++) {
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");
830 dump_dictionary(fcode_env_t
*env
)
834 log_message(MSG_INFO
, "Dictionary dump: base: %p\n", env
->base
);
835 for (ptr
= (uchar_t
*)(((long)(env
->base
)) & ~0xf); ptr
< HERE
;
841 acf_to_fcode_name(fcode_env_t
*env
, acf_t acf
)
845 for (i
= 0; i
< MAX_FCODE
; i
++)
846 if (env
->table
[i
].apf
== acf
)
847 return (env
->table
[i
].name
);
852 acf_match(fcode_env_t
*env
, acf_t sacf
, void *macf
)
854 if (sacf
== (acf_t
)macf
)
860 * Given an ACF, return ptr to name or "unknown" string.
863 acf_to_name(fcode_env_t
*env
, acf_t acf
)
866 static char name_buf
[256];
870 if (!within_dictionary(env
, acf
)) {
871 if ((bip
= lookup_builtin((token_t
)acf
)) != NULL
)
872 return (bip
->bi_name
);
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
);
886 within_word(fcode_env_t
*env
, acf_t acf
, acf_t wacf
)
888 if (acf
== wacf
|| acf
+ 1 == wacf
)
890 if (*acf
== (token_t
)(&do_colon
)) {
894 } while (*acf
++ != (token_t
)(&semi_ptr
));
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?).
905 acf_backup_search(fcode_env_t
*env
, acf_t acf
)
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
))
915 if (nacf
>= (acf_t
)env
->base
&& *nacf
== (token_t
)(&do_colon
) &&
916 (name
= get_name(ACF_TO_LINK(nacf
))) != NULL
)
919 return (acf_to_str(acf
));
923 * Print out current process's C stack using /usr/proc/bin/pstack
926 ctrace(fcode_env_t
*env
)
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
);
936 while (fgets(buf
, sizeof (buf
), fd
))
937 log_message(MSG_DEBUG
, buf
);
943 * Dump data, return stacks, try to unthread forth calling stack.
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");
957 * Handle fatal error, if interactive mode, return to ok prompt.
960 forth_abort(fcode_env_t
*env
, char *fmt
, ...)
965 if (in_forth_abort
) {
966 log_message(MSG_FATAL
, "ABORT: abort within forth_abort\n");
972 vsprintf(msg
, fmt
, ap
);
973 log_message(MSG_ERROR
, "ABORT: %s\n", msg
);
980 return_to_interact(env
);
982 * If not in interactive mode, return_to_interact just returns.
988 * Handle fatal system call error
991 forth_perror(fcode_env_t
*env
, char *fmt
, ...)
995 int save_errno
= errno
; /* just in case... */
998 vsprintf(msg
, fmt
, ap
);
1000 forth_abort(env
, "%s: %s", msg
, strerror(save_errno
));
1004 show_stack(fcode_env_t
*env
)
1007 debug_level
^= DEBUG_SHOW_STACK
;
1014 print_bytes_header(int width
, int offset
)
1018 for (i
= 0; i
< width
; i
++)
1019 log_message(MSG_INFO
, " ");
1020 log_message(MSG_INFO
, " ");
1021 for (i
= 0; i
< 16; i
++) {
1023 log_message(MSG_INFO
, " ");
1025 log_message(MSG_INFO
, "\\/ ");
1027 log_message(MSG_INFO
, "%2x ", i
);
1029 log_message(MSG_INFO
, " ");
1030 for (i
= 0; i
< 16; i
++) {
1032 log_message(MSG_INFO
, "v");
1034 log_message(MSG_INFO
, "%x", i
);
1036 log_message(MSG_INFO
, "\n");
1040 dump(fcode_env_t
*env
)
1047 data
= (uchar_t
*)POP(DS
);
1048 offset
= ((long)data
) & 0xf;
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)
1058 do_sifting(fcode_env_t
*env
, acf_t acf
, void *pat
)
1062 if ((name
= get_name(ACF_TO_LINK(acf
))) != NULL
&& strstr(name
, pat
))
1063 output_acf_name(acf
);
1068 sifting(fcode_env_t
*env
)
1072 if ((pat
= parse_a_string(env
, NULL
)) != NULL
) {
1073 (void) search_all_dictionaries(env
, do_sifting
, pat
);
1074 output_acf_name(NULL
);
1079 print_level(int level
, int *doprint
)
1084 log_message(MSG_DEBUG
, "\n ");
1085 for (i
= 0; i
< level
; i
++)
1086 log_message(MSG_DEBUG
, " ");
1104 #define BI_NOTYET 14 /* unimplented in "see" */
1106 struct bitab bitab
[] = {
1107 (token_t
)("e_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
,
1145 lookup_builtin(token_t builtin
)
1149 for (i
= 0; bitab
[i
].bi_ptr
; i
++)
1150 if (bitab
[i
].bi_ptr
== builtin
)
1156 paren_see(fcode_env_t
*env
)
1158 acf_t save_acf
= (acf_t
)POP(DS
);
1159 acf_t acf
= save_acf
;
1161 token_t brtab
[30], thentab
[30], brstk
[30];
1162 int nbrtab
= 0, nthentab
= 0, nbrstk
= 0;
1164 int level
= 0, doprintlevel
= 1, nthen
;
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
);
1173 log_message(MSG_INFO
, "%s: builtin\n",
1174 acf_to_name(env
, acf
));
1177 log_message(MSG_INFO
, ": %s", acf_to_name(env
, acf
));
1178 for (pass
= 0; pass
< 2; pass
++) {
1180 for (acf
++; ; acf
++) {
1182 print_level(level
, &doprintlevel
);
1183 for (nthen
= 0; nthentab
> 0 &&
1184 thentab
[nthentab
-1] == (token_t
)acf
;
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];
1202 print_level(level
, &doprintlevel
);
1203 if (case_lit
== (token_t
)acf
) {
1204 log_message(MSG_INFO
, "case ");
1206 print_level(level
, &doprintlevel
);
1208 if (endof_loc
== (token_t
)acf
) {
1209 log_message(MSG_INFO
, "endof ");
1211 print_level(level
, &doprintlevel
);
1213 if (endcase_loc
== (token_t
)acf
) {
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
;
1222 log_message(MSG_INFO
, "%s ",
1223 acf_to_name(env
, (acf_t
)*acf
));
1226 if (bip
->bi_type
== BI_SEMI
) {
1228 log_message(MSG_INFO
, "\n");
1229 log_message(MSG_INFO
, "%s\n",
1234 switch (bip
->bi_type
) {
1239 log_message(MSG_INFO
, "%s ",
1245 log_message(MSG_INFO
, "\" ");
1250 log_message(MSG_INFO
, "%s\" ", p
);
1252 for (; ((token_t
)(p
)) & (sizeof (token_t
) - 1);
1262 log_message(MSG_INFO
, "%x ", *acf
);
1268 log_message(MSG_INFO
, "%s ",
1279 if (*acf
< (token_t
)acf
) {
1285 log_message(MSG_INFO
,
1289 log_message(MSG_INFO
,
1291 } else if (nthentab
) {
1293 print_level(level
- 1,
1295 log_message(MSG_INFO
, "else ");
1297 thentab
[nthentab
- 1] = *acf
;
1300 if (*acf
< (token_t
)acf
) {
1301 brtab
[nbrtab
++] = *acf
;
1302 brtab
[nbrtab
++] = (token_t
)acf
;
1304 if (endcase_loc
== 0 &&
1314 if (*acf
< (token_t
)acf
) {
1320 log_message(MSG_INFO
,
1324 log_message(MSG_INFO
,
1326 } else if (nbrstk
> 0 &&
1327 *acf
>= brstk
[nbrstk
- 1]) {
1329 print_level(level
- 1,
1331 log_message(MSG_INFO
,
1335 log_message(MSG_INFO
, "if ");
1338 thentab
[nthentab
++] = *acf
;
1340 } else if (*acf
< (token_t
)acf
) {
1341 brtab
[nbrtab
++] = *acf
;
1342 brtab
[nbrtab
++] = (token_t
)acf
;
1349 log_message(MSG_INFO
, "of ");
1351 } else if (case_lit
== 0) {
1352 case_lit
= last_lit
;
1361 print_level(level
, &doprintlevel
);
1362 log_message(MSG_INFO
, "%s ",
1369 log_message(MSG_ERROR
, "Invalid builtin %s\n",
1377 see(fcode_env_t
*env
)
1387 log_message(MSG_WARN
, "?");
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
)) {
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
);
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
);
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;
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");
1444 fcode_debug(fcode_env_t
*env
)
1446 PUSH(DS
, (fstack_t
)(&env
->fcode_debug
));
1450 base_addr(fcode_env_t
*env
)
1452 PUSH(DS
, (fstack_t
)env
->base
);
1455 static int mw_valid
;
1457 static void *mw_addr
;
1458 static fstack_t mw_value
;
1459 static fstack_t mw_lastvalue
;
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
));
1474 do_memory_watch(fcode_env_t
*env
)
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
,
1489 mw_lastvalue
= value
;
1494 set_memory_watch(fcode_env_t
*env
, int type
, int size
, void *addr
,
1498 case 1: case 2: case 4: case 8:
1501 log_message(MSG_ERROR
, "set_memory_watch: invalid size: %d\n",
1509 mw_lastvalue
= mw_fetch();
1513 memory_watch(fcode_env_t
*env
)
1516 void *addr
= (void *)POP(DS
);
1518 set_memory_watch(env
, 1, size
, addr
, 0);
1522 memory_watch_value(fcode_env_t
*env
)
1525 void *addr
= (void *)POP(DS
);
1526 fstack_t value
= POP(DS
);
1528 set_memory_watch(env
, 2, size
, addr
, value
);
1532 memory_watch_clear(fcode_env_t
*env
)
1538 vsearch(fcode_env_t
*env
)
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
) {
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;
1555 log_message(MSG_INFO
, "Invalid size: %d\n", size
);
1558 if (value
== match_value
)
1559 log_message(MSG_INFO
, "%p\n", fromaddr
);
1568 fcode_env_t
*env
= initial_env
;
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
);