#include "gc.h"
#include "search.h"
#include "purify.h"
+#include "globals.h"
+#include "lispregs.h"
+#include "interrupt.h"
+#include "genesis/static-symbols.h"
+#include "genesis/primitive-objects.h"
+
+
/* 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
typedef void cmd(char **ptr);
-static cmd call_cmd, dump_cmd, print_cmd, quit_cmd, help_cmd;
+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;
{"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},
#if defined(__i386__)
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);
obj = *end;
addr = end;
end += 2;
- if (TypeOf(obj) == type_SimpleFunHeader) {
+ if (widetag_of(obj) == SIMPLE_FUN_HEADER_WIDETAG) {
print((long)addr | FUN_POINTER_LOWTAG);
- } else if (lowtagof(obj) == OTHER_IMMEDIATE_0_LOWTAG ||
- lowtagof(obj) == OTHER_IMMEDIATE_1_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);
}
}
-static void
-call_cmd(char **ptr)
-{
- lispobj thing = parse_lispobj(ptr), function, result = 0, cons, args[3];
- int numargs;
-
- if (lowtagof(thing) == OTHER_POINTER_LOWTAG) {
- switch (TypeOf(*(lispobj *)(thing-OTHER_POINTER_LOWTAG))) {
- 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)->fun;
- 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) != FUN_POINTER_LOWTAG) {
- 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 supported)\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 arg count made it past validity check?!");
- }
-
- print(result);
-}
+/* (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)
fflush(stdout);
fgets(buf, sizeof(buf), ldb_in);
if (buf[0] == 'y' || buf[0] == 'Y' || buf[0] == '\n')
- exit(0);
+ exit(1);
}
static void
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]);
+ 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)));
+ 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)));
+ }
+ printf("PC:\t\t 0x%08lx\n",
+ (unsigned long)(*os_context_pc_addr(context)));
}
static void
print_context_cmd(char **ptr)
{
- int free;
+ int free;
- free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
+ free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>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(lisp_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(lisp_interrupt_contexts[free - 1]);
}
+ }
}
static void