Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / monitor.c
1 /*
2
3  This code was written as part of the CMU Common Lisp project at
4  Carnegie Mellon University, and has been placed in the public domain.
5
6 */
7
8 #include <stdio.h>
9 #include <sys/types.h>
10 #include <stdlib.h>
11 #include <setjmp.h>
12 #include <sys/time.h>
13 #include <sys/resource.h>
14 #include <signal.h>
15 #include <string.h>
16
17 #include "lisp.h"
18 #include "internals.h"
19 #include "globals.h"
20 #include "vars.h"
21 #include "parse.h"
22 #include "os.h"
23 #include "interrupt.h"
24 #include "lispregs.h"
25 #include "monitor.h"
26 #include "print.h"
27 #include "arch.h"
28 #include "gc.h"
29 #include "search.h"
30 #include "purify.h"
31 #if defined GENCGC
32 #include "gencgc.h"
33 #endif
34
35 extern boolean isatty(int fd);
36
37 typedef void cmd(char **ptr);
38
39 static cmd call_cmd, dump_cmd, print_cmd, quit, help;
40 static cmd flush_cmd, search_cmd, regs_cmd, exit_cmd;
41 static cmd gc_cmd, print_context_cmd;
42 static cmd backtrace_cmd, purify_cmd, catchers_cmd;
43 static cmd grab_sigs_cmd;
44
45 static struct cmd {
46     char *cmd, *help;
47     void (*fn) (char **ptr);
48 } Cmds[] = {
49     /* *INDENT-OFF* */
50     {"help", "Display this info", help},
51     {"?", NULL, help},
52     {"backtrace", "backtrace up to N frames", backtrace_cmd},
53     {"call", "call FUNCTION with ARG1, ARG2, ...", call_cmd},
54     {"catchers", "Print a list of all the active catchers.", catchers_cmd},
55     {"context", "print interrupt context number I.", print_context_cmd},
56     {"dump", "dump memory starting at ADDRESS for COUNT words.", dump_cmd},
57     {"d", NULL, dump_cmd},
58     {"exit", "Exit this instance of the monitor.", exit_cmd},
59     {"flush", "flush all temp variables.", flush_cmd},
60     {"gc", "collect garbage (caveat collector).", gc_cmd},
61     {"grab-signals", "Set the signal handlers to call LDB.", grab_sigs_cmd},
62     {"purify", "purify (caveat purifier).", purify_cmd},
63     {"print", "print object at ADDRESS.", print_cmd},
64     {"p", NULL, print_cmd},
65     {"quit", "quit.", quit},
66     {"regs", "display current lisp regs.", regs_cmd},
67     {"search", "search for TYPE starting at ADDRESS for a max of COUNT words.", search_cmd},
68     {"s", NULL, search_cmd},
69     {NULL, NULL, NULL}
70     /* *INDENT-ON* */
71 };
72
73
74 static jmp_buf curbuf;
75
76
77 static int
78 visable(unsigned char c)
79 {
80     if (c < ' ' || c > '~')
81         return ' ';
82     else
83         return c;
84 }
85
86 static void
87 dump_cmd(char **ptr)
88 {
89     static char *lastaddr = 0;
90     static int lastcount = 20;
91
92     char *addr = lastaddr;
93     int count = lastcount, displacement;
94
95     if (more_p(ptr)) {
96         addr = parse_addr(ptr);
97
98         if (more_p(ptr))
99             count = parse_number(ptr);
100     }
101
102     if (count == 0) {
103         printf("COUNT must be non-zero.\n");
104         return;
105     }
106
107     lastcount = count;
108
109     if (count > 0)
110         displacement = 4;
111     else {
112         displacement = -4;
113         count = -count;
114     }
115
116     while (count-- > 0) {
117 #ifndef alpha
118         printf("0x%08lX: ", (unsigned long) addr);
119 #else
120         printf("0x%08X: ", (u32) addr);
121 #endif
122         if (valid_addr((os_vm_address_t) addr)) {
123 #ifndef alpha
124             unsigned long *lptr = (unsigned long *) addr;
125 #else
126             u32 *lptr = (unsigned long *) addr;
127 #endif
128             unsigned short *sptr = (unsigned short *) addr;
129             unsigned char *cptr = (unsigned char *) addr;
130
131             printf
132                 ("0x%08lx   0x%04x 0x%04x   0x%02x 0x%02x 0x%02x 0x%02x    %c%c%c%c\n",
133                  lptr[0], sptr[0], sptr[1], cptr[0], cptr[1], cptr[2], cptr[3],
134                  visable(cptr[0]), visable(cptr[1]), visable(cptr[2]),
135                  visable(cptr[3]));
136         } else
137             printf("invalid address\n");
138
139         addr += displacement;
140     }
141
142     lastaddr = addr;
143 }
144
145 static void
146 print_cmd(char **ptr)
147 {
148     lispobj obj = parse_lispobj(ptr);
149
150     print(obj);
151 }
152
153 static void
154 regs_cmd(char **ptr)
155 {
156     printf("CSP\t=\t0x%08lX\n", (unsigned long) current_control_stack_pointer);
157     printf("FP\t=\t0x%08lX\n", (unsigned long) current_control_frame_pointer);
158 #if !defined(ibmrt) && !defined(i386) && !defined(__x86_64)
159     printf("BSP\t=\t0x%08lX\n", (unsigned long) current_binding_stack_pointer);
160 #endif
161 #if defined(i386) || defined(__x86_64)
162     printf("BSP\t=\t0x%08lX\n", SymbolValue(BINDING_STACK_POINTER));
163 #endif
164
165     printf("DYNAMIC\t=\t0x%08lX\n", (unsigned long) current_dynamic_space);
166 #if defined(ibmrt) || defined(i386) || defined(__x86_64)
167     printf("ALLOC\t=\t0x%08lX\n", SymbolValue(ALLOCATION_POINTER));
168     printf("TRIGGER\t=\t0x%08lX\n", SymbolValue(INTERNAL_GC_TRIGGER));
169 #else
170     printf("ALLOC\t=\t0x%08lX\n",
171            (unsigned long) current_dynamic_space_free_pointer);
172     printf("TRIGGER\t=\t0x%08lX\n", (unsigned long) current_auto_gc_trigger);
173 #endif
174     printf("STATIC\t=\t0x%08lX\n", SymbolValue(STATIC_SPACE_FREE_POINTER));
175     printf("RDONLY\t=\t0x%08lX\n", SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
176
177 #ifdef MIPS
178     printf("FLAGS\t=\t0x%08x\n", current_flags_register);
179 #endif
180 }
181
182 static void
183 search_cmd(char **ptr)
184 {
185     static int lastval = 0, lastcount = 0;
186     static lispobj *start = 0, *end = 0;
187     int val, count;
188     lispobj *addr, obj;
189
190     if (more_p(ptr)) {
191         val = parse_number(ptr);
192         if (val < 0 || val > 0xff) {
193             printf("Can only search for single bytes.\n");
194             return;
195         }
196         if (more_p(ptr)) {
197             addr = (lispobj *) PTR((long) parse_addr(ptr));
198             if (more_p(ptr)) {
199                 count = parse_number(ptr);
200             } else {
201                 /* Speced value and address, but no count. Only one. */
202                 count = -1;
203             }
204         } else {
205             /* Speced a value, but no address, so search same range. */
206             addr = start;
207             count = lastcount;
208         }
209     } else {
210         /* Speced nothing, search again for val. */
211         val = lastval;
212         addr = end;
213         count = lastcount;
214     }
215
216     lastval = val;
217     start = end = addr;
218     lastcount = count;
219
220     printf("searching for 0x%x at 0x%08lX\n", val, (unsigned long) end);
221
222     while (search_for_type(val, &end, &count)) {
223         printf("found 0x%x at 0x%08lX:\n", val, (unsigned long) end);
224         obj = *end;
225         addr = end;
226         end += 2;
227         if (TypeOf(obj) == type_FunctionHeader)
228             print((long) addr | type_FunctionPointer);
229         else if (LowtagOf(obj) == type_OtherImmediate0
230                  || LowtagOf(obj) ==
231                  type_OtherImmediate1) print((lispobj) addr |
232                                              type_OtherPointer);
233         else
234             print((lispobj) addr);
235         if (count == -1)
236             return;
237     }
238 }
239
240 static void
241 call_cmd(char **ptr)
242 {
243     lispobj thing = parse_lispobj(ptr);
244     lispobj function, cons, args[3];
245     lispobj result = NIL;
246
247     int numargs;
248
249     if (LowtagOf(thing) == type_OtherPointer) {
250         switch (TypeOf(*(lispobj *) (thing - type_OtherPointer))) {
251           case type_SymbolHeader:
252               for (cons = SymbolValue(INITIAL_FDEFN_OBJECTS);
253                    cons != NIL; cons = CONS(cons)->cdr) {
254                   if (FDEFN(CONS(cons)->car)->name == thing) {
255                       thing = CONS(cons)->car;
256                       goto fdefn;
257                   }
258               }
259               printf("symbol 0x%08lx is undefined.\n", thing);
260               return;
261
262           case type_Fdefn:
263             fdefn:
264               function = FDEFN(thing)->function;
265               if (function == NIL) {
266                   printf("fdefn 0x%08lx is undefined.\n", thing);
267                   return;
268               }
269               break;
270           default:
271               printf
272                   ("0x%08lx is not a function pointer, symbol, or fdefn object.\n",
273                    thing);
274               return;
275         }
276     } else if (LowtagOf(thing) != type_FunctionPointer) {
277         printf("0x%08lx is not a function pointer, symbol, or fdefn object.\n",
278                thing);
279         return;
280     } else
281         function = thing;
282
283     numargs = 0;
284     while (more_p(ptr)) {
285         if (numargs >= 3) {
286             printf("Too many arguments.  3 at most.\n");
287             return;
288         }
289         args[numargs++] = parse_lispobj(ptr);
290     }
291
292     switch (numargs) {
293       case 0:
294           result = funcall0(function);
295           break;
296       case 1:
297           result = funcall1(function, args[0]);
298           break;
299       case 2:
300           result = funcall2(function, args[0], args[1]);
301           break;
302       case 3:
303           result = funcall3(function, args[0], args[1], args[2]);
304           break;
305     }
306
307     print(result);
308 }
309
310 static void
311 flush_cmd(char **ptr)
312 {
313     flush_vars();
314 }
315
316 static void
317 quit(char **ptr)
318 {
319     char buf[10];
320     char *result; 
321
322     printf("Really quit? [y] ");
323     fflush(stdout);
324     result = fgets(buf, sizeof(buf), stdin);
325     if (result && (buf[0] == 'y' || buf[0] == 'Y' || buf[0] == '\n')) {
326         exit(0);
327     }
328 }
329
330 static void
331 help(char **ptr)
332 {
333     struct cmd *cmd;
334
335     for (cmd = Cmds; cmd->cmd != NULL; cmd++)
336         if (cmd->help != NULL)
337             printf("%s\t%s\n", cmd->cmd, cmd->help);
338 }
339
340 static int done;
341
342 static void
343 exit_cmd(char **ptr)
344 {
345     done = TRUE;
346 }
347
348 static void
349 gc_cmd(char **ptr)
350 {
351     collect_garbage();
352 }
353
354 static void
355 purify_cmd(char **ptr)
356 {
357     purify(NIL, NIL);
358 }
359
360 static void
361 print_context(os_context_t * context)
362 {
363     int i;
364
365     for (i = 0; i < NREGS; i++) {
366         printf("%s:\t", lisp_register_names[i]);
367 #if defined(i386) || defined(__x86_64)
368         brief_print((lispobj) SC_REG(context, i * 2));
369 #else
370         brief_print((lispobj) SC_REG(context, i));
371 #endif
372     }
373     printf("PC:\t\t  0x%08lx\n", (unsigned long) SC_PC(context));
374 }
375
376 static void
377 print_context_cmd(char **ptr)
378 {
379     int free;
380
381     free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX) >> 2;
382
383     if (more_p(ptr)) {
384         int index;
385
386         index = parse_number(ptr);
387
388         if ((index >= 0) && (index < free)) {
389             printf("There are %d interrupt contexts.\n", free);
390             printf("Printing context %d\n", index);
391             print_context(lisp_interrupt_contexts[index]);
392         } else {
393             printf("There aren't that many/few contexts.\n");
394             printf("There are %d interrupt contexts.\n", free);
395         }
396     } else {
397         if (free == 0)
398             printf("There are no interrupt contexts!\n");
399         else {
400             printf("There are %d interrupt contexts.\n", free);
401             printf("Printing context %d\n", free - 1);
402             print_context(lisp_interrupt_contexts[free - 1]);
403         }
404     }
405 }
406
407 static void
408 backtrace_cmd(char **ptr)
409 {
410     void backtrace(int frames);
411     int n;
412
413     if (more_p(ptr))
414         n = parse_number(ptr);
415     else
416         n = 100;
417
418     printf("Backtrace:\n");
419     backtrace(n);
420 }
421
422 static void
423 catchers_cmd(char **ptr)
424 {
425     struct catch_block *catch;
426
427     catch = (struct catch_block *) SymbolValue(CURRENT_CATCH_BLOCK);
428
429     if (catch == NULL)
430         printf("There are no active catchers!\n");
431     else {
432         while (catch != NULL) {
433 #if !(defined(i386) || defined(__x86_64))
434             printf
435                 ("0x%08lX:\n\tuwp: 0x%08lX\n\tfp: 0x%08lX\n\tcode: 0x%08lx\n\tentry: 0x%08lx\n\ttag: ",
436                  (unsigned long) catch, (unsigned long) (catch->current_uwp),
437                  (unsigned long) (catch->current_cont), catch->current_code,
438                  catch->entry_pc);
439 #else
440             printf
441                 ("0x%08lX:\n\tuwp: 0x%08lX\n\tfp: 0x%08lX\n\tcode: 0x%p\n\tentry: 0x%08lx\n\ttag: ",
442                  (unsigned long) catch, (unsigned long) (catch->current_uwp),
443                  (unsigned long) (catch->current_cont),
444                  component_ptr_from_pc((lispobj *) catch->entry_pc) +
445                  type_OtherPointer, catch->entry_pc);
446 #endif
447             brief_print((lispobj) catch->tag);
448             catch = catch->previous_catch;
449         }
450     }
451 }
452
453 static void
454 grab_sigs_cmd(char **ptr)
455 {
456     extern void sigint_init(void);
457
458     printf("Grabbing signals.\n");
459     sigint_init();
460 }
461
462 static void
463 sub_monitor(void)
464 {
465     struct cmd *cmd, *found;
466     char buf[256];
467     char *line, *ptr, *token;
468     int ambig;
469
470     while (!done) {
471         printf("ldb> ");
472         fflush(stdout);
473         line = fgets(buf, sizeof(buf), stdin);
474         if (line == NULL) {
475             if (isatty(0)) {
476                 putchar('\n');
477                 /*
478                     * We can no longer read anything from stdin, so
479                     * just exit this loop instead of spewing an
480                     * endless stream of prompts.  This also means we
481                     * can't use ldb anymore because stdin is
482                     * unreadable.
483                     */
484                 break;
485             } else {
486                 fprintf(stderr, "\nEOF on something other than a tty.\n");
487                 exit(1);
488             }
489         }
490         ptr = line;
491         if ((token = parse_token(&ptr)) == NULL)
492             continue;
493         ambig = 0;
494         found = NULL;
495         for (cmd = Cmds; cmd->cmd != NULL; cmd++) {
496             if (strcmp(token, cmd->cmd) == 0) {
497                 found = cmd;
498                 ambig = 0;
499                 break;
500             } else if (strncmp(token, cmd->cmd, strlen(token)) == 0) {
501                 if (found)
502                     ambig = 1;
503                 else
504                     found = cmd;
505             }
506         }
507         if (ambig)
508             printf("``%s'' is ambiguous.\n", token);
509         else if (found == NULL)
510             printf("unknown command: ``%s''\n", token);
511         else {
512             reset_printer();
513             (*found->fn) (&ptr);
514         }
515     }
516 }
517
518 void
519 ldb_monitor(void)
520 {
521     jmp_buf oldbuf;
522
523     memcpy(oldbuf, curbuf, sizeof(jmp_buf));
524
525     printf("LDB monitor\n");
526
527     setjmp(curbuf);
528
529     sub_monitor();
530
531     done = FALSE;
532
533     memcpy(curbuf, oldbuf, sizeof(jmp_buf));
534 }
535
536 void
537 throw_to_monitor(void)
538 {
539     longjmp(curbuf, 1);
540 }