Rename slots in unwind-block and catch-block.
[sbcl.git] / src / runtime / monitor.c
blobf345bda8af5ed467031549543c9e698c1d94e0f2
1 /*
2 * This software is part of the SBCL system. See the README file for
3 * more information.
5 * This software is derived from the CMU CL system, which was
6 * written at Carnegie Mellon University and released into the
7 * public domain. The software is in the public domain and is
8 * provided with absolutely no warranty. See the COPYING and CREDITS
9 * files for more information.
12 #include "sbcl.h"
14 #include <stdio.h>
15 #include <sys/types.h>
16 #include <stdlib.h>
17 #include <setjmp.h>
18 #include <sys/time.h>
19 #ifndef LISP_FEATURE_WIN32
20 #include <sys/resource.h>
21 #endif
22 #include <signal.h>
23 #include <unistd.h>
25 #include "runtime.h"
26 #include "parse.h"
27 #include "vars.h"
29 /* Almost all of this file can be skipped if we're not supporting LDB. */
30 #if defined(LISP_FEATURE_SB_LDB)
32 #include "print.h"
33 #include "arch.h"
34 #include "interr.h"
35 #include "gc.h"
36 #include "search.h"
37 #include "purify.h"
38 #include "globals.h"
39 #include "lispregs.h"
40 #include "interrupt.h"
41 #include "thread.h"
42 #include "genesis/static-symbols.h"
43 #include "genesis/primitive-objects.h"
47 /* When we need to do command input, we use this stream, which is not
48 * in general stdin, so that things will "work" (as well as being
49 * thrown into ldb can be considered "working":-) even in a process
50 * where standard input has been redirected to a file or pipe.
52 * (We could set up output to go to a special ldb_out stream for the
53 * same reason, but there's been no pressure for that so far.)
55 * The enter-the-ldb-monitor function is responsible for setting up
56 * this stream. */
57 static FILE *ldb_in = 0;
58 static int ldb_in_fd = -1;
60 typedef void cmd(char **ptr);
62 static cmd dump_cmd, print_cmd, quit_cmd, help_cmd;
63 static cmd flush_cmd, search_cmd, regs_cmd, exit_cmd;
64 static cmd print_context_cmd;
65 static cmd backtrace_cmd, purify_cmd, catchers_cmd;
66 static cmd grab_sigs_cmd;
67 static cmd kill_cmd;
69 static struct cmd {
70 char *cmd, *help;
71 void (*fn)(char **ptr);
72 } supported_cmds[] = {
73 {"help", "Display this help information.", help_cmd},
74 {"?", "(an alias for help)", help_cmd},
75 {"backtrace", "Backtrace up to N frames.", backtrace_cmd},
76 {"catchers", "Print a list of all the active catchers.", catchers_cmd},
77 {"context", "Print interrupt context number I.", print_context_cmd},
78 {"dump", "Dump memory starting at ADDRESS for COUNT words.", dump_cmd},
79 {"d", "(an alias for dump)", dump_cmd},
80 {"exit", "Exit this instance of the monitor.", exit_cmd},
81 {"flush", "Flush all temp variables.", flush_cmd},
82 /* (Classic CMU CL had a "gc" command here, which seems like a
83 * reasonable idea, but the code was stale (incompatible with
84 * gencgc) so I just flushed it. -- WHN 20000814 */
85 {"grab-signals", "Set the signal handlers to call LDB.", grab_sigs_cmd},
86 {"kill", "Kill ourself with signal number N (useful if running under gdb)",
87 kill_cmd},
88 {"purify", "Purify. (Caveat purifier!)", purify_cmd},
89 {"print", "Print object at ADDRESS.", print_cmd},
90 {"p", "(an alias for print)", print_cmd},
91 {"quit", "Quit.", quit_cmd},
92 {"regs", "Display current Lisp registers.", regs_cmd},
93 {"search", "Search for TYPE starting at ADDRESS for a max of COUNT words.", search_cmd},
94 {"s", "(an alias for search)", search_cmd},
95 {NULL, NULL, NULL}
98 static jmp_buf curbuf;
100 static int
101 visible(unsigned char c)
103 if (c < ' ' || c > '~')
104 return ' ';
105 else
106 return c;
109 static void
110 dump_cmd(char **ptr)
112 static char *lastaddr = 0;
113 static int lastcount = 20;
115 char *addr = lastaddr;
116 int count = lastcount, displacement;
118 if (more_p(ptr)) {
119 addr = parse_addr(ptr);
121 if (more_p(ptr))
122 count = parse_number(ptr);
125 if (count == 0) {
126 printf("COUNT must be non-zero.\n");
127 return;
130 lastcount = count;
132 if (count > 0)
133 displacement = N_WORD_BYTES;
134 else {
135 displacement = -N_WORD_BYTES;
136 count = -count;
139 while (count-- > 0) {
140 #ifndef LISP_FEATURE_ALPHA
141 printf("%p: ", (os_vm_address_t) addr);
142 #else
143 printf("0x%08X: ", (u32) addr);
144 #endif
145 if (is_valid_lisp_addr((os_vm_address_t)addr)) {
146 #ifndef LISP_FEATURE_ALPHA
147 unsigned long *lptr = (unsigned long *)addr;
148 #else
149 u32 *lptr = (u32 *)addr;
150 #endif
151 unsigned char *cptr = (unsigned char *)addr;
153 #if N_WORD_BYTES == 8
154 printf("0x%016lx | %c%c%c%c%c%c%c%c\n",
155 lptr[0],
156 visible(cptr[0]), visible(cptr[1]),
157 visible(cptr[2]), visible(cptr[3]),
158 visible(cptr[4]), visible(cptr[5]),
159 visible(cptr[6]), visible(cptr[7]));
160 #else
161 unsigned short *sptr = (unsigned short *)addr;
162 printf("0x%08lx 0x%04x 0x%04x "
163 "0x%02x 0x%02x 0x%02x 0x%02x "
164 "%c%c"
165 "%c%c\n",
166 lptr[0], sptr[0], sptr[1],
167 cptr[0], cptr[1], cptr[2], cptr[3],
168 visible(cptr[0]), visible(cptr[1]),
169 visible(cptr[2]), visible(cptr[3]));
170 #endif
172 else
173 printf("invalid Lisp-level address\n");
175 addr += displacement;
178 lastaddr = addr;
181 static void
182 print_cmd(char **ptr)
184 lispobj obj = parse_lispobj(ptr);
186 print(obj);
189 static void
190 kill_cmd(char **ptr)
192 #ifndef LISP_FEATURE_WIN32
193 kill(getpid(), parse_number(ptr));
194 #endif
197 static void
198 regs_cmd(char **ptr)
200 struct thread *thread=arch_os_get_current_thread();
202 printf("CSP\t=\t%p ", access_control_stack_pointer(thread));
203 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
204 printf("CFP\t=\t%p ", access_control_frame_pointer(thread));
205 #endif
207 #ifdef reg_BSP
208 printf("BSP\t=\t%p\n", get_binding_stack_pointer(thread));
209 #else
210 /* printf("BSP\t=\t0x%08lx\n",
211 (unsigned long)SymbolValue(BINDING_STACK_POINTER)); */
212 printf("\n");
213 #endif
215 #ifdef LISP_FEATURE_GENCGC
216 /* printf("DYNAMIC\t=\t0x%08lx\n", DYNAMIC_SPACE_START); */
217 #else
218 printf("STATIC\t=\t%p ",
219 SymbolValue(STATIC_SPACE_FREE_POINTER, thread));
220 printf("RDONLY\t=\t0x%08lx ",
221 (unsigned long)SymbolValue(READ_ONLY_SPACE_FREE_POINTER, thread));
222 printf("DYNAMIC\t=\t0x%08lx\n", (unsigned long)current_dynamic_space);
223 #endif
225 #ifdef reg_ALLOC
226 printf("ALLOC\t=\t0x%08lx\n", (unsigned long)dynamic_space_free_pointer);
227 #else
228 printf("ALLOC\t=\t0x%08lx\n",
229 (unsigned long)SymbolValue(ALLOCATION_POINTER, thread));
230 #endif
232 #ifndef LISP_FEATURE_GENCGC
233 printf("TRIGGER\t=\t0x%08lx\n", (unsigned long)current_auto_gc_trigger);
234 #endif
237 static void
238 search_cmd(char **ptr)
240 static int lastval = 0, lastcount = 0;
241 static lispobj *start = 0, *end = 0;
242 int val, count;
243 lispobj *addr, obj;
245 if (more_p(ptr)) {
246 val = parse_number(ptr);
247 if (val < 0 || val > 0xff) {
248 printf("can only search for single bytes\n");
249 return;
251 if (more_p(ptr)) {
252 addr = (lispobj *)native_pointer((uword_t)parse_addr(ptr));
253 if (more_p(ptr)) {
254 count = parse_number(ptr);
256 else {
257 /* Specified value and address, but no count. Only one. */
258 count = -1;
261 else {
262 /* Specified a value, but no address, so search same range. */
263 addr = start;
264 count = lastcount;
267 else {
268 /* Specified nothing, search again for val. */
269 val = lastval;
270 addr = end;
271 count = lastcount;
274 lastval = val;
275 start = end = addr;
276 lastcount = count;
278 printf("searching for 0x%x at %p\n", val, (void*)(uword_t)end);
280 while (search_for_type(val, &end, &count)) {
281 printf("found 0x%x at %p:\n", val, (void*)(uword_t)end);
282 obj = *end;
283 addr = end;
284 end += 2;
285 if (widetag_of(obj) == SIMPLE_FUN_HEADER_WIDETAG) {
286 print((uword_t)addr | FUN_POINTER_LOWTAG);
287 } else if (other_immediate_lowtag_p(obj)) {
288 print((lispobj)addr | OTHER_POINTER_LOWTAG);
289 } else {
290 print((lispobj)addr);
291 } if (count == -1) {
292 return;
297 /* (There used to be call_cmd() here, to call known-at-cold-init-time
298 * Lisp functions from ldb, but it bitrotted and was deleted in
299 * sbcl-0.7.5.1. See older CVS versions if you want to resuscitate
300 * it.) */
302 static void
303 flush_cmd(char **ptr)
305 flush_vars();
308 static void
309 quit_cmd(char **ptr)
311 char buf[10];
313 printf("Really quit? [y] ");
314 fflush(stdout);
315 if (fgets(buf, sizeof(buf), ldb_in)) {
316 if (buf[0] == 'y' || buf[0] == 'Y' || buf[0] == '\n')
317 exit(1);
318 } else {
319 printf("\nUnable to read response, assuming y.\n");
320 exit(1);
324 static void
325 help_cmd(char **ptr)
327 struct cmd *cmd;
329 for (cmd = supported_cmds; cmd->cmd != NULL; cmd++)
330 if (cmd->help != NULL)
331 printf("%s\t%s\n", cmd->cmd, cmd->help);
334 static int done;
336 static void
337 exit_cmd(char **ptr)
339 done = 1;
342 static void
343 purify_cmd(char **ptr)
345 purify(NIL, NIL);
348 static void
349 print_context(os_context_t *context)
351 int i;
353 for (i = 0; i < NREGS; i++) {
354 printf("%s:\t", lisp_register_names[i]);
355 #ifdef LISP_FEATURE_X86
356 brief_print((lispobj)(*os_context_register_addr(context,
357 i*2)));
358 #else
359 brief_print((lispobj)(*os_context_register_addr(context,i)));
360 #endif
362 #ifdef LISP_FEATURE_DARWIN
363 printf("DAR:\t\t 0x%08lx\n", (unsigned long)(*os_context_register_addr(context, 41)));
364 printf("DSISR:\t\t 0x%08lx\n", (unsigned long)(*os_context_register_addr(context, 42)));
365 #endif
366 printf("PC:\t\t 0x%08lx\n",
367 (unsigned long)(*os_context_pc_addr(context)));
370 static void
371 print_context_cmd(char **ptr)
373 int free_ici;
374 struct thread *thread=arch_os_get_current_thread();
376 free_ici = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread));
378 if (more_p(ptr)) {
379 int index;
381 index = parse_number(ptr);
383 if ((index >= 0) && (index < free_ici)) {
384 printf("There are %d interrupt contexts.\n", free_ici);
385 printf("printing context %d\n", index);
386 print_context(thread->interrupt_contexts[index]);
387 } else {
388 printf("There aren't that many/few contexts.\n");
389 printf("There are %d interrupt contexts.\n", free_ici);
391 } else {
392 if (free_ici == 0)
393 printf("There are no interrupt contexts!\n");
394 else {
395 printf("There are %d interrupt contexts.\n", free_ici);
396 printf("printing context %d\n", free_ici - 1);
397 print_context(thread->interrupt_contexts[free_ici - 1]);
402 static void
403 backtrace_cmd(char **ptr)
405 void lisp_backtrace(int frames);
406 int n;
408 if (more_p(ptr))
409 n = parse_number(ptr);
410 else
411 n = 100;
413 printf("Backtrace:\n");
414 lisp_backtrace(n);
417 static void
418 catchers_cmd(char **ptr)
420 struct catch_block *catch;
421 struct thread *thread=arch_os_get_current_thread();
423 catch = (struct catch_block *)SymbolValue(CURRENT_CATCH_BLOCK,thread);
425 if (catch == NULL)
426 printf("There are no active catchers!\n");
427 else {
428 while (catch != NULL) {
429 printf("0x%08lX:\n\tuwp: 0x%08lX\n\tfp: 0x%08lX\n\t"
430 "code: 0x%08lX\n\tentry: 0x%08lX\n\ttag: ",
431 (uword_t)catch,
432 (uword_t)(catch->uwp),
433 (uword_t)(catch->cfp),
434 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
435 (uword_t)component_ptr_from_pc((void*)catch->entry_pc)
436 + OTHER_POINTER_LOWTAG,
437 #else
438 (uword_t)(catch->code),
439 #endif
440 (uword_t)(catch->entry_pc));
441 brief_print((lispobj)catch->tag);
442 catch = catch->previous_catch;
447 static void
448 grab_sigs_cmd(char **ptr)
450 extern void sigint_init(void);
452 printf("Grabbing signals.\n");
453 sigint_init();
456 static void
457 sub_monitor(void)
459 struct cmd *cmd, *found;
460 char buf[256];
461 char *line, *ptr, *token;
462 int ambig;
464 if (!ldb_in) {
465 #ifndef LISP_FEATURE_WIN32
466 ldb_in = fopen("/dev/tty","r+");
467 if (ldb_in == NULL) {
468 perror("Error opening /dev/tty");
469 ldb_in = stdin;
471 #else
472 ldb_in = stdin;
473 #endif
474 ldb_in_fd = fileno(ldb_in);
477 while (!done) {
478 printf("ldb> ");
479 fflush(stdout);
480 line = fgets(buf, sizeof(buf), ldb_in);
481 if (line == NULL) {
482 exit(1);
484 ptr = line;
485 if ((token = parse_token(&ptr)) == NULL)
486 continue;
487 ambig = 0;
488 found = NULL;
489 for (cmd = supported_cmds; cmd->cmd != NULL; cmd++) {
490 if (strcmp(token, cmd->cmd) == 0) {
491 found = cmd;
492 ambig = 0;
493 break;
495 else if (strncmp(token, cmd->cmd, strlen(token)) == 0) {
496 if (found)
497 ambig = 1;
498 else
499 found = cmd;
502 if (ambig)
503 printf("``%s'' is ambiguous.\n", token);
504 else if (found == NULL)
505 printf("unknown command: ``%s''\n", token);
506 else {
507 reset_printer();
508 (*found->fn)(&ptr);
513 void
514 ldb_monitor()
516 jmp_buf oldbuf;
518 bcopy(curbuf, oldbuf, sizeof(oldbuf));
520 printf("Welcome to LDB, a low-level debugger for the Lisp runtime environment.\n");
522 setjmp(curbuf);
524 sub_monitor();
526 done = 0;
528 bcopy(oldbuf, curbuf, sizeof(curbuf));
531 void
532 throw_to_monitor()
534 longjmp(curbuf, 1);
537 #endif /* defined(LISP_FEATURE_SB_LDB) */
539 /* what we do when things go badly wrong at a low level */
540 void
541 monitor_or_something()
543 #if defined(LISP_FEATURE_SB_LDB)
544 ldb_monitor();
545 #else
546 fprintf(stderr,
547 "The system is too badly corrupted or confused to continue at the Lisp\n\
548 level. If the system had been compiled with the SB-LDB feature, we'd drop\n\
549 into the LDB low-level debugger now. But there's no LDB in this build, so\n\
550 we can't really do anything but just exit, sorry.\n");
551 exit(1);
552 #endif