#include "gc.h"
#include "search.h"
#include "purify.h"
+#include "globals.h"
+#include "lispregs.h"
+#include "interrupt.h"
+#include "genesis/static-symbols.h"
+#include "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) {
- print((long)addr | type_FunPointer);
- } else if (LowtagOf(obj) == type_OtherImmediate0 ||
- LowtagOf(obj) == type_OtherImmediate1) {
- print((lispobj)addr | type_OtherPointer);
+ 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) {
}
}
-static void
-call_cmd(char **ptr)
-{
- lispobj thing = parse_lispobj(ptr), function, result = 0, 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)->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) != type_FunPointer) {
- 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)
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
(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);
projects / sbcl.git / blobdiff