0.9.0.8:
[sbcl.git] / src / runtime / monitor.c
index bc3800e..222d27e 100644 (file)
 #include <sys/time.h>
 #include <sys/resource.h>
 #include <signal.h>
+#include <unistd.h>
 
-#include "runtime.h"
 #include "sbcl.h"
-#include "globals.h"
-#include "vars.h"
-#include "parse.h"
-#include "os.h"
-#include "interrupt.h"
-#include "lispregs.h"
-#include "monitor.h"
+#include "runtime.h"
+
+/* Almost all of this file can be skipped if we're not supporting LDB. */
+#if defined(LISP_FEATURE_SB_LDB)
+
 #include "print.h"
 #include "arch.h"
 #include "interr.h"
 #include "gc.h"
 #include "search.h"
 #include "purify.h"
+#include "globals.h"
+#include "lispregs.h"
+#include "interrupt.h"
+#include "thread.h"
+#include "genesis/static-symbols.h"
+#include "genesis/primitive-objects.h"
 
-extern boolean isatty(int fd);
+
+
+/* When we need to do command input, we use this stream, which is not
+ * in general stdin, so that things will "work" (as well as being
+ * thrown into ldb can be considered "working":-) even in a process
+ * where standard input has been redirected to a file or pipe.
+ *
+ * (We could set up output to go to a special ldb_out stream for the
+ * same reason, but there's been no pressure for that so far.)
+ * 
+ * The enter-the-ldb-monitor function is responsible for setting up
+ * this stream. */
+static FILE *ldb_in = 0;
+static int ldb_in_fd = -1;
 
 typedef void cmd(char **ptr);
 
-static cmd call_cmd, dump_cmd, print_cmd, quit, help;
+static cmd dump_cmd, print_cmd, quit_cmd, help_cmd;
 static cmd flush_cmd, search_cmd, regs_cmd, exit_cmd;
 static cmd print_context_cmd;
 static cmd backtrace_cmd, purify_cmd, catchers_cmd;
 static cmd grab_sigs_cmd;
+static cmd kill_cmd;
 
 static struct cmd {
     char *cmd, *help;
     void (*fn)(char **ptr);
-} Cmds[] = {
-    {"help", "Display this help information.", help},
-    {"?", "help", help},
+} supported_cmds[] = {
+    {"help", "Display this help information.", help_cmd},
+    {"?", "(an alias for help)", help_cmd},
     {"backtrace", "Backtrace up to N frames.", backtrace_cmd},
-    {"call", "Call FUNCTION with ARG1, ARG2, ...", call_cmd},
     {"catchers", "Print a list of all the active catchers.", catchers_cmd},
     {"context", "Print interrupt context number I.", print_context_cmd},
     {"dump", "Dump memory starting at ADDRESS for COUNT words.", dump_cmd},
-    {"d", "dump", dump_cmd},
+    {"d", "(an alias for dump)", dump_cmd},
     {"exit", "Exit this instance of the monitor.", exit_cmd},
     {"flush", "Flush all temp variables.", flush_cmd},
     /* (Classic CMU CL had a "gc" command here, which seems like a
      * reasonable idea, but the code was stale (incompatible with
      * gencgc) so I just flushed it. -- WHN 20000814 */
     {"grab-signals", "Set the signal handlers to call LDB.", grab_sigs_cmd},
+    {"kill", "Kill ourself with signal number N (useful if running under gdb)",
+     kill_cmd},
     {"purify", "Purify. (Caveat purifier!)", purify_cmd},
     {"print", "Print object at ADDRESS.", print_cmd},
-    {"p", "print", print_cmd},
-    {"quit", "Quit.", quit},
-    {"regs", "Display current Lisp regs.", regs_cmd},
+    {"p", "(an alias for print)", print_cmd},
+    {"quit", "Quit.", quit_cmd},
+    {"regs", "Display current Lisp registers.", regs_cmd},
     {"search", "Search for TYPE starting at ADDRESS for a max of COUNT words.", search_cmd},
-    {"s", "search", search_cmd},
+    {"s", "(an alias for search)", search_cmd},
     {NULL, NULL, NULL}
 };
 
 static jmp_buf curbuf;
 
-static int visible(unsigned char c)
+static int
+visible(unsigned char c)
 {
     if (c < ' ' || c > '~')
         return ' ';
@@ -81,7 +101,8 @@ static int visible(unsigned char c)
         return c;
 }
 
-static void dump_cmd(char **ptr)
+static void
+dump_cmd(char **ptr)
 {
     static char *lastaddr = 0;
     static int lastcount = 20;
@@ -111,16 +132,16 @@ static void dump_cmd(char **ptr)
     }
 
     while (count-- > 0) {
-#ifndef alpha
+#ifndef LISP_FEATURE_ALPHA
         printf("0x%08lX: ", (unsigned long) addr);
 #else
         printf("0x%08X: ", (u32) addr);
 #endif
         if (is_valid_lisp_addr((os_vm_address_t)addr)) {
-#ifndef alpha
+#ifndef LISP_FEATURE_ALPHA
             unsigned long *lptr = (unsigned long *)addr;
 #else
-            u32 *lptr = (unsigned long *)addr;
+            u32 *lptr = (u32 *)addr;
 #endif
             unsigned short *sptr = (unsigned short *)addr;
             unsigned char *cptr = (unsigned char *)addr;
@@ -136,31 +157,38 @@ static void dump_cmd(char **ptr)
     lastaddr = addr;
 }
 
-static void print_cmd(char **ptr)
+static void
+print_cmd(char **ptr)
 {
     lispobj obj = parse_lispobj(ptr);
 
     print(obj);
 }
 
-static void regs_cmd(char **ptr)
+static void
+kill_cmd(char **ptr)
+{
+    kill(getpid(), parse_number(ptr));
+}
+
+static void
+regs_cmd(char **ptr)
 {
     printf("CSP\t=\t0x%08lX\n", (unsigned long)current_control_stack_pointer);
     printf("FP\t=\t0x%08lX\n", (unsigned long)current_control_frame_pointer);
-#if !defined(ibmrt) && !defined(__i386__)
+#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
     printf("BSP\t=\t0x%08X\n", (unsigned long)current_binding_stack_pointer);
 #endif
-#ifdef __i386__
+#if 0
+#if (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
     printf("BSP\t=\t0x%08lx\n",
           (unsigned long)SymbolValue(BINDING_STACK_POINTER));
 #endif
 
     printf("DYNAMIC\t=\t0x%08lx\n", (unsigned long)DYNAMIC_SPACE_START);
-#if defined(ibmrt) || defined(__i386__)
+#if (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
     printf("ALLOC\t=\t0x%08lx\n",
           (unsigned long)SymbolValue(ALLOCATION_POINTER));
-    printf("TRIGGER\t=\t0x%08lx\n",
-          (unsigned long)SymbolValue(INTERNAL_GC_TRIGGER));
 #else
     printf("ALLOC\t=\t0x%08X\n",
           (unsigned long)dynamic_space_free_pointer);
@@ -170,13 +198,11 @@ static void regs_cmd(char **ptr)
           (unsigned long)SymbolValue(STATIC_SPACE_FREE_POINTER));
     printf("RDONLY\t=\t0x%08lx\n",
           (unsigned long)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
-
-#ifdef MIPS
-    printf("FLAGS\t=\t0x%08x\n", current_flags_register);
-#endif
+#endif /* 0 */
 }
 
-static void search_cmd(char **ptr)
+static void
+search_cmd(char **ptr)
 {
     static int lastval = 0, lastcount = 0;
     static lispobj *start = 0, *end = 0;
@@ -186,27 +212,27 @@ static void search_cmd(char **ptr)
     if (more_p(ptr)) {
         val = parse_number(ptr);
         if (val < 0 || val > 0xff) {
-            printf("Can only search for single bytes.\n");
+            printf("can only search for single bytes\n");
             return;
         }
         if (more_p(ptr)) {
-            addr = (lispobj *)PTR((long)parse_addr(ptr));
+            addr = (lispobj *)native_pointer((long)parse_addr(ptr));
             if (more_p(ptr)) {
                 count = parse_number(ptr);
             }
             else {
-                /* Speced value and address, but no count. Only one. */
+                /* Specified value and address, but no count. Only one. */
                 count = -1;
             }
         }
         else {
-            /* Speced a value, but no address, so search same range. */
+            /* Specified a value, but no address, so search same range. */
             addr = start;
             count = lastcount;
         }
     }
     else {
-        /* Speced nothing, search again for val. */
+        /* Specified nothing, search again for val. */
         val = lastval;
         addr = end;
         count = lastcount;
@@ -223,174 +249,122 @@ static void search_cmd(char **ptr)
         obj = *end;
         addr = end;
         end += 2;
-        if (TypeOf(obj) == type_FunctionHeader)
-            print((long)addr | type_FunctionPointer);
-        else if (LowtagOf(obj) == type_OtherImmediate0 || LowtagOf(obj) == type_OtherImmediate1)
-            print((lispobj)addr | type_OtherPointer);
-        else
+        if (widetag_of(obj) == SIMPLE_FUN_HEADER_WIDETAG) {
+            print((long)addr | FUN_POINTER_LOWTAG);
+        } else if (lowtag_of(obj) == OTHER_IMMEDIATE_0_LOWTAG ||
+                  lowtag_of(obj) == OTHER_IMMEDIATE_1_LOWTAG) {
+            print((lispobj)addr | OTHER_POINTER_LOWTAG);
+        } else {
             print((lispobj)addr);
-        if (count == -1)
+        } if (count == -1) {
             return;
-    }
-}
-
-static void call_cmd(char **ptr)
-{
-    lispobj thing = parse_lispobj(ptr), function, result, cons, args[3];
-    int numargs;
-
-    if (LowtagOf(thing) == type_OtherPointer) {
-       switch (TypeOf(*(lispobj *)(thing-type_OtherPointer))) {
-         case type_SymbolHeader:
-           for (cons = SymbolValue(INITIAL_FDEFN_OBJECTS);
-                cons != NIL;
-                cons = CONS(cons)->cdr) {
-               if (FDEFN(CONS(cons)->car)->name == thing) {
-                   thing = CONS(cons)->car;
-                   goto fdefn;
-               }
-           }
-           printf("symbol 0x%08lx is undefined.\n", (long unsigned)thing);
-           return;
-
-         case type_Fdefn:
-         fdefn:
-           function = FDEFN(thing)->function;
-           if (function == NIL) {
-               printf("fdefn 0x%08lx is undefined.\n", (long unsigned)thing);
-               return;
-           }
-           break;
-         default:
-           printf("0x%08lx is not a function pointer, symbol, "
-                  "or fdefn object.\n",
-                  (long unsigned)thing);
-           return;
-       }
-    }
-    else if (LowtagOf(thing) != type_FunctionPointer) {
-        printf("0x%08lx is not a function pointer, symbol, or fdefn object.\n",
-              (long unsigned)thing);
-        return;
-    }
-    else
-       function = thing;
-
-    numargs = 0;
-    while (more_p(ptr)) {
-       if (numargs >= 3) {
-           printf("too many arguments (no more than 3 allowed)\n");
-           return;
        }
-       args[numargs++] = parse_lispobj(ptr);
-    }
-
-    switch (numargs) {
-    case 0:
-       result = funcall0(function);
-       break;
-    case 1:
-       result = funcall1(function, args[0]);
-       break;
-    case 2:
-       result = funcall2(function, args[0], args[1]);
-       break;
-    case 3:
-       result = funcall3(function, args[0], args[1], args[2]);
-       break;
-    default:
-       lose("unsupported argument count");
     }
-
-    print(result);
 }
 
-static void flush_cmd(char **ptr)
+/* (There used to be call_cmd() here, to call known-at-cold-init-time
+ * Lisp functions from ldb, but it bitrotted and was deleted in
+ * sbcl-0.7.5.1. See older CVS versions if you want to resuscitate
+ * it.) */
+
+static void
+flush_cmd(char **ptr)
 {
     flush_vars();
 }
 
-static void quit(char **ptr)
+static void
+quit_cmd(char **ptr)
 {
     char buf[10];
 
     printf("Really quit? [y] ");
     fflush(stdout);
-    fgets(buf, sizeof(buf), stdin);
+    fgets(buf, sizeof(buf), ldb_in);
     if (buf[0] == 'y' || buf[0] == 'Y' || buf[0] == '\n')
-        exit(0);
+        exit(1);
 }
 
-static void help(char **ptr)
+static void
+help_cmd(char **ptr)
 {
     struct cmd *cmd;
 
-    for (cmd = Cmds; cmd->cmd != NULL; cmd++)
+    for (cmd = supported_cmds; cmd->cmd != NULL; cmd++)
         if (cmd->help != NULL)
             printf("%s\t%s\n", cmd->cmd, cmd->help);
 }
 
 static int done;
 
-static void exit_cmd(char **ptr)
+static void
+exit_cmd(char **ptr)
 {
     done = 1;
 }
 
-static void purify_cmd(char **ptr)
+static void
+purify_cmd(char **ptr)
 {
     purify(NIL, NIL);
 }
 
-static void print_context(os_context_t *context)
+static void
+print_context(os_context_t *context)
 {
-       int i;
+    int i;
 
-       for (i = 0; i < NREGS; i++) {
-               printf("%s:\t", lisp_register_names[i]);
-#ifdef __i386__
-               brief_print((lispobj)(*os_context_register_addr(context,
-                                                               i*2)));
+    for (i = 0; i < NREGS; i++) {
+       printf("%s:\t", lisp_register_names[i]);
+#ifdef LISP_FEATURE_X86
+       brief_print((lispobj)(*os_context_register_addr(context,
+                                                       i*2)));
 #else
-               brief_print((lispobj)(*os_context_register_addr(context,
-                                                               i)));
+       brief_print((lispobj)(*os_context_register_addr(context,i)));
 #endif
-       }
-       printf("PC:\t\t  0x%08lx\n",
-              (unsigned long)(*os_context_pc_addr(context)));
+    }
+#ifdef LISP_FEATURE_DARWIN
+    printf("DAR:\t\t 0x%08lx\n", (unsigned long)(*os_context_register_addr(context, 41)));
+    printf("DSISR:\t\t 0x%08lx\n", (unsigned long)(*os_context_register_addr(context, 42)));
+#endif
+    printf("PC:\t\t  0x%08lx\n",
+          (unsigned long)(*os_context_pc_addr(context)));
 }
 
-static void print_context_cmd(char **ptr)
+static void
+print_context_cmd(char **ptr)
 {
-       int free;
+    int free;
+    struct thread *thread=arch_os_get_current_thread();
 
-       free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
+    free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
        
-        if (more_p(ptr)) {
-               int index;
-
-               index = parse_number(ptr);
-
-               if ((index >= 0) && (index < free)) {
-                       printf("There are %d interrupt contexts.\n", free);
-                       printf("Printing context %d\n", index);
-                       print_context(lisp_interrupt_contexts[index]);
-               } else {
-                       printf("There aren't that many/few contexts.\n");
-                       printf("There are %d interrupt contexts.\n", free);
-               }
+    if (more_p(ptr)) {
+       int index;
+
+       index = parse_number(ptr);
+
+       if ((index >= 0) && (index < free)) {
+           printf("There are %d interrupt contexts.\n", free);
+           printf("printing context %d\n", index);
+           print_context(thread->interrupt_contexts[index]);
        } else {
-               if (free == 0)
-                       printf("There are no interrupt contexts!\n");
-               else {
-                       printf("There are %d interrupt contexts.\n", free);
-                       printf("Printing context %d\n", free - 1);
-                       print_context(lisp_interrupt_contexts[free - 1]);
-               }
+           printf("There aren't that many/few contexts.\n");
+           printf("There are %d interrupt contexts.\n", free);
+       }
+    } else {
+       if (free == 0)
+           printf("There are no interrupt contexts!\n");
+       else {
+           printf("There are %d interrupt contexts.\n", free);
+           printf("printing context %d\n", free - 1);
+           print_context(thread->interrupt_contexts[free - 1]);
        }
+    }
 }
 
-static void backtrace_cmd(char **ptr)
+static void
+backtrace_cmd(char **ptr)
 {
     void backtrace(int frames);
     int n;
@@ -404,17 +378,19 @@ static void backtrace_cmd(char **ptr)
     backtrace(n);
 }
 
-static void catchers_cmd(char **ptr)
+static void
+catchers_cmd(char **ptr)
 {
     struct catch_block *catch;
+    struct thread *thread=arch_os_get_current_thread();
 
-    catch = (struct catch_block *)SymbolValue(CURRENT_CATCH_BLOCK);
+    catch = (struct catch_block *)SymbolValue(CURRENT_CATCH_BLOCK,thread);
 
     if (catch == NULL)
         printf("There are no active catchers!\n");
     else {
         while (catch != NULL) {
-#ifndef __i386__
+#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
             printf("0x%08lX:\n\tuwp: 0x%08lX\n\tfp: 0x%08lX\n\tcode: 0x%08lx\n\tentry: 0x%08lx\n\ttag: ",
                   (unsigned long)catch, (unsigned long)(catch->current_uwp),
                   (unsigned long)(catch->current_cont),
@@ -425,7 +401,7 @@ static void catchers_cmd(char **ptr)
                   (unsigned long)catch, (unsigned long)(catch->current_uwp),
                   (unsigned long)(catch->current_cont),
                   (unsigned long)component_ptr_from_pc((void*)catch->entry_pc) +
-                  type_OtherPointer,
+                  OTHER_POINTER_LOWTAG,
                   (unsigned long)catch->entry_pc);
 #endif
             brief_print((lispobj)catch->tag);
@@ -434,7 +410,8 @@ static void catchers_cmd(char **ptr)
     }
 }
 
-static void grab_sigs_cmd(char **ptr)
+static void
+grab_sigs_cmd(char **ptr)
 {
     extern void sigint_init(void);
 
@@ -442,19 +419,25 @@ static void grab_sigs_cmd(char **ptr)
     sigint_init();
 }
 
-static void sub_monitor(void)
+static void
+sub_monitor(void)
 {
     struct cmd *cmd, *found;
     char buf[256];
     char *line, *ptr, *token;
     int ambig;
 
+    if (!ldb_in) {
+       ldb_in = fopen("/dev/tty","r+");
+       ldb_in_fd = fileno(ldb_in);
+    }
+
     while (!done) {
         printf("ldb> ");
         fflush(stdout);
-        line = fgets(buf, sizeof(buf), stdin);
+        line = fgets(buf, sizeof(buf), ldb_in);
         if (line == NULL) {
-           if (isatty(0)) {
+           if (isatty(ldb_in_fd)) {
                putchar('\n');
                continue;
            }
@@ -468,7 +451,7 @@ static void sub_monitor(void)
             continue;
         ambig = 0;
         found = NULL;
-        for (cmd = Cmds; cmd->cmd != NULL; cmd++) {
+        for (cmd = supported_cmds; cmd->cmd != NULL; cmd++) {
             if (strcmp(token, cmd->cmd) == 0) {
                 found = cmd;
                 ambig = 0;
@@ -492,7 +475,8 @@ static void sub_monitor(void)
     }
 }
 
-void ldb_monitor()
+void
+ldb_monitor()
 {
     jmp_buf oldbuf;
 
@@ -509,7 +493,26 @@ void ldb_monitor()
     bcopy(oldbuf, curbuf, sizeof(curbuf));
 }
 
-void throw_to_monitor()
+void
+throw_to_monitor()
 {
     longjmp(curbuf, 1);
 }
+
+#endif /* defined(LISP_FEATURE_SB_LDB) */
+
+/* what we do when things go badly wrong at a low level */
+void
+monitor_or_something()
+{
+#if defined(LISP_FEATURE_SB_LDB)
+    ldb_monitor();
+#else
+     fprintf(stderr,
+"The system is too badly corrupted or confused to continue at the Lisp\n\
+level. If the system had been compiled with the SB-LDB feature, we'd drop\n\
+into the LDB low-level debugger now. But there's no LDB in this build, so\n\
+we can't really do anything but just exit, sorry.\n");
+    exit(1);
+#endif
+}