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
set_interpreter_debug_level(long lvl)55 set_interpreter_debug_level(long lvl)
56 {
57 debug_level = lvl;
58 }
59
60 long
get_interpreter_debug_level(void)61 get_interpreter_debug_level(void)
62 {
63 return (debug_level);
64 }
65
66 void
output_data_stack(fcode_env_t * env,int msglevel)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
output_return_stack(fcode_env_t * env,int show_wa,int msglevel)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
dump_comma(fcode_env_t * env,char * type)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
add_debug_acf(fcode_env_t * env,acf_t acf)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
paren_debug(fcode_env_t * env)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
debug(fcode_env_t * env)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
order_to_dict_list(fcode_env_t * env,token_t * order[])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
search_all_dictionaries(fcode_env_t * env,acf_t (* fn)(fcode_env_t *,acf_t,void *),void * arg)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 *
acf_to_str(acf_t acf)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 *
get_name_or_acf(token_t * dptr)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
output_acf_name(acf_t acf)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
dot_debug(fcode_env_t * env)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
do_undebug(fcode_env_t * env,char * name)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
undebug(fcode_env_t * env)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
name_is_debugged(fcode_env_t * env,char * name)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
is_debug_word(fcode_env_t * env,acf_t acf)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
debug_set_level(fcode_env_t * env,int level)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
find_semi_in_colon_def(fcode_env_t * env,acf_t acf)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
check_for_debug_entry(fcode_env_t * env)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
check_for_debug_exit(fcode_env_t * env)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
check_semi_debug_exit(fcode_env_t * env)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
current_debug_state(fcode_env_t * env)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
clear_debug_state(fcode_env_t * env,int oldstate)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
unbug(fcode_env_t * env)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
output_vitals(fcode_env_t * env)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
do_exec_debug(fcode_env_t * env,void * fn)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
smatch(fcode_env_t * env)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
check_vitals(fcode_env_t * env)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
dump_table(fcode_env_t * env)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
verify_usage(fcode_env_t * env)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
debugf(fcode_env_t * env)640 debugf(fcode_env_t *env)
641 {
642 PUSH(DS, (fstack_t)&debug_level);
643 }
644
645 static void
control(fcode_env_t * env)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
debug_flags_to_output(fcode_env_t * env,int flags)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
dot_debugf(fcode_env_t * env)707 dot_debugf(fcode_env_t *env)
708 {
709 debug_flags_to_output(env, debug_level);
710 }
711
712 static void
debugf_qmark(fcode_env_t * env)713 debugf_qmark(fcode_env_t *env)
714 {
715 debug_flags_to_output(env, 0xffffffff);
716 }
717
718 int
debug_flags_to_mask(char * str)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
set_debugf(fcode_env_t * env)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
show_a_word(fcode_env_t * env,acf_t acf,void * arg)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
words(fcode_env_t * env)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
dump_a_word(fcode_env_t * env,acf_t acf,void * arg)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
dump_words(fcode_env_t * env)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
dump_line(uchar_t * ptr)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
dump_dictionary(fcode_env_t * env)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 *
acf_to_fcode_name(fcode_env_t * env,acf_t acf)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
acf_match(fcode_env_t * env,acf_t sacf,void * macf)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 *
acf_to_name(fcode_env_t * env,acf_t acf)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
within_dictionary(fcode_env_t * env,void * addr)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
within_word(fcode_env_t * env,acf_t acf,acf_t wacf)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 *
acf_backup_search(fcode_env_t * env,acf_t acf)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
ctrace(fcode_env_t * env)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
ftrace(fcode_env_t * env)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
forth_abort(fcode_env_t * env,char * fmt,...)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
forth_perror(fcode_env_t * env,char * fmt,...)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
show_stack(fcode_env_t * env)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
print_bytes_header(int width,int offset)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
dump(fcode_env_t * env)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
do_sifting(fcode_env_t * env,acf_t acf,void * pat)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
sifting(fcode_env_t * env)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
print_level(int level,int * doprint)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)("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,
1141 0
1142 };
1143
1144 struct bitab *
lookup_builtin(token_t builtin)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
paren_see(fcode_env_t * env)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
see(fcode_env_t * env)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
do_dot_calls(fcode_env_t * env,acf_t acf,void * cacf)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
dot_calls(fcode_env_t * env)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
dot_pci_space(fcode_env_t * env)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
fcode_debug(fcode_env_t * env)1444 fcode_debug(fcode_env_t *env)
1445 {
1446 PUSH(DS, (fstack_t)(&env->fcode_debug));
1447 }
1448
1449 static void
base_addr(fcode_env_t * env)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
mw_fetch(void)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
do_memory_watch(fcode_env_t * env)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
set_memory_watch(fcode_env_t * env,int type,int size,void * addr,fstack_t value)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
memory_watch(fcode_env_t * env)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
memory_watch_value(fcode_env_t * env)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
memory_watch_clear(fcode_env_t * env)1532 memory_watch_clear(fcode_env_t *env)
1533 {
1534 mw_valid = 0;
1535 }
1536
1537 static void
vsearch(fcode_env_t * env)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
_init(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