src/runtime/print.c

   1 /* code for low-level debugging/diagnostic output */
   2
   3 /*
   4  * This software is part of the SBCL system. See the README file for
   5  * more information.
   6  *
   7  * This software is derived from the CMU CL system, which was
   8  * written at Carnegie Mellon University and released into the
   9  * public domain. The software is in the public domain and is
  10  * provided with absolutely no warranty. See the COPYING and CREDITS
  11  * files for more information.
  12  */
  13
  14 /*
  15  * FIXME:
  16  *   Some of the code in here (the various
  17  *   foo_slots[], at least) is deeply broken, depending on guessing
  18  *   already out-of-date values instead of getting them from sbcl.h.
  19  */
  20
  21 #include <stdio.h>
  22 #include <string.h>
  23
  24 #include "sbcl.h"
  25 #include "print.h"
  26 #include "runtime.h"
  27
  28 /* This file can be skipped if we're not supporting LDB. */
  29 #if defined(LISP_FEATURE_SB_LDB)
  30
  31 #include "monitor.h"
  32 #include "vars.h"
  33 #include "os.h"
  34 #include "gencgc-alloc-region.h" /* genesis/thread.h needs this */
  35 #include "genesis/static-symbols.h"
  36 #include "genesis/primitive-objects.h"
  37
  38 #include "genesis/static-symbols.h"
  39
  40
  41
  42 static int max_lines = 20, cur_lines = 0;
  43 static int max_depth = 5, brief_depth = 2, cur_depth = 0;
  44 static int max_length = 5;
  45 static boolean dont_descend = 0, skip_newline = 0;
  46 static int cur_clock = 0;
  47
  48 static void print_obj(char *prefix, lispobj obj);
  49
  50 #define NEWLINE_OR_RETURN if (continue_p(1)) newline(NULL); else return;
  51
  52 /* FIXME: This should be auto-generated by whatever generates
  53    constants.h so we don't have to maintain this twice! */
  54 #ifdef LISP_FEATURE_X86_64
  55 char *lowtag_Names[] = {
  56     "even fixnum",
  57     "instance pointer",
  58     "other immediate [0]",
  59     "unknown [3]",
  60     "unknown [4]",
  61     "unknown [5]",
  62     "other immediate [1]",
  63     "list pointer",
  64     "odd fixnum",
  65     "function pointer",
  66     "other immediate [2]",
  67     "unknown [11]",
  68     "unknown [12]",
  69     "unknown [13]",
  70     "other immediate [3]",
  71     "other pointer"
  72 };
  73 #else
  74 char *lowtag_Names[] = {
  75     "even fixnum",
  76     "instance pointer",
  77     "other immediate [0]",
  78     "list pointer",
  79     "odd fixnum",
  80     "function pointer",
  81     "other immediate [1]",
  82     "other pointer"
  83 };
  84 #endif
  85
  86 /* FIXME: Yikes! This table implicitly depends on the values in sbcl.h,
  87  * but doesn't actually depend on them, so if they change, it gets
  88  * all broken. We should either get rid of it or
  89  * rewrite the code so that it's cleanly initialized by gc_init_tables[]
  90  * in a way which varies correctly with the values in sbcl.h. */
  91 char *subtype_Names[] = {
  92     "unused 0",
  93     "unused 1",
  94     "bignum",
  95     "ratio",
  96     "single float",
  97     "double float",
  98 #ifdef LONG_FLOAT_WIDETAG
  99     "long float",
 100 #endif
 101     "complex",
 102 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
 103     "complex single float",
 104 #endif
 105 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
 106     "complex double float",
 107 #endif
 108 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
 109     "complex long float",
 110 #endif
 111     "simple-array",
 112     "simple-string",
 113     "simple-bit-vector",
 114     "simple-vector",
 115     "(simple-array (unsigned-byte 2) (*))",
 116     "(simple-array (unsigned-byte 4) (*))",
 117     "(simple-array (unsigned-byte 8) (*))",
 118     "(simple-array (unsigned-byte 16) (*))",
 119     "(simple-array (unsigned-byte 32) (*))",
 120 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
 121     "(simple-array (signed-byte 8) (*))",
 122 #endif
 123 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
 124     "(simple-array (signed-byte 16) (*))",
 125 #endif
 126 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
 127     "(simple-array fixnum (*))",
 128 #endif
 129 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
 130     "(simple-array (signed-byte 32) (*))",
 131 #endif
 132     "(simple-array single-float (*))",
 133     "(simple-array double-float (*))",
 134 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
 135     "(simple-array long-float (*))",
 136 #endif
 137 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
 138     "(simple-array (complex single-float) (*))",
 139 #endif
 140 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
 141     "(simple-array (complex double-float) (*))",
 142 #endif
 143 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
 144     "(simple-array (complex long-float) (*))",
 145 #endif
 146     "complex-string",
 147     "complex-bit-vector",
 148     "(array * (*))",
 149     "array",
 150     "code header",
 151     "function header",
 152     "closure header",
 153     "funcallable-instance header",
 154     "unused function header 1",
 155     "unused function header 2",
 156     "unused function header 3",
 157     "closure function header",
 158     "return PC header",
 159     "value cell header",
 160     "symbol header",
 161     "character",
 162     "SAP",
 163     "unbound marker",
 164     "weak pointer",
 165     "instance header",
 166     "fdefn"
 167 };
 168
 169 static void indent(int in)
 170 {
 171     static char *spaces = "                                                                ";
 172
 173     while (in > 64) {
 174         fputs(spaces, stdout);
 175         in -= 64;
 176     }
 177     if (in != 0)
 178         fputs(spaces + 64 - in, stdout);
 179 }
 180
 181 static boolean continue_p(boolean newline)
 182 {
 183     char buffer[256];
 184
 185     if (cur_depth >= max_depth || dont_descend)
 186         return 0;
 187
 188     if (newline) {
 189         if (skip_newline)
 190             skip_newline = 0;
 191         else
 192             putchar('\n');
 193
 194         if (cur_lines >= max_lines) {
 195             printf("More? [y] ");
 196             fflush(stdout);
 197
 198             fgets(buffer, sizeof(buffer), stdin);
 199
 200             if (buffer[0] == 'n' || buffer[0] == 'N')
 201                 throw_to_monitor();
 202             else
 203                 cur_lines = 0;
 204         }
 205     }
 206
 207     return 1;
 208 }
 209
 210 static void newline(char *label)
 211 {
 212     cur_lines++;
 213     if (label != NULL)
 214         fputs(label, stdout);
 215     putchar('\t');
 216     indent(cur_depth * 2);
 217 }
 218
 219
 220 static void brief_fixnum(lispobj obj)
 221 {
 222 #ifndef LISP_FEATURE_ALPHA
 223     printf("%ld", ((long)obj)>>2);
 224 #else
 225     printf("%d", ((s32)obj)>>2);
 226 #endif
 227 }
 228
 229 static void print_fixnum(lispobj obj)
 230 {
 231 #ifndef LISP_FEATURE_ALPHA
 232     printf(": %ld", ((long)obj)>>2);
 233 #else
 234     printf(": %d", ((s32)obj)>>2);
 235 #endif
 236 }
 237
 238 static void brief_otherimm(lispobj obj)
 239 {
 240     int type, c;
 241     unsigned int idx;
 242     char buffer[10];
 243
 244     type = widetag_of(obj);
 245     switch (type) {
 246         case CHARACTER_WIDETAG:
 247             c = (obj>>8)&0xff;
 248             switch (c) {
 249                 case '\0':
 250                     printf("#\\Null");
 251                     break;
 252                 case '\n':
 253                     printf("#\\Newline");
 254                     break;
 255                 case '\b':
 256                     printf("#\\Backspace");
 257                     break;
 258                 case '\177':
 259                     printf("#\\Delete");
 260                     break;
 261                 default:
 262                     strcpy(buffer, "#\\");
 263                     if (c >= 128) {
 264                         strcat(buffer, "m-");
 265                         c -= 128;
 266                     }
 267                     if (c < 32) {
 268                         strcat(buffer, "c-");
 269                         c += '@';
 270                     }
 271                     printf("%s%c", buffer, c);
 272                     break;
 273             }
 274             break;
 275
 276         case UNBOUND_MARKER_WIDETAG:
 277             printf("<unbound marker>");
 278             break;
 279
 280         default:
 281             idx = type >> 2;
 282             if (idx < (sizeof(lowtag_Names) / sizeof(char *)))
 283                     printf("%s", lowtag_Names[idx]);
 284             else
 285                     printf("unknown type (0x%0x)", type);
 286             break;
 287     }
 288 }
 289
 290 static void print_otherimm(lispobj obj)
 291 {
 292     int type;
 293
 294     unsigned int idx;
 295
 296     type = widetag_of(obj);
 297     idx = type >> 2;
 298
 299     if (idx < (sizeof(lowtag_Names) / sizeof(char *)))
 300             printf(", %s", lowtag_Names[idx]);
 301     else
 302             printf(", unknown type (0x%0x)", type);
 303
 304     switch (widetag_of(obj)) {
 305         case CHARACTER_WIDETAG:
 306             printf(": ");
 307             brief_otherimm(obj);
 308             break;
 309
 310         case SAP_WIDETAG:
 311         case UNBOUND_MARKER_WIDETAG:
 312             break;
 313
 314         default:
 315             printf(": data=%ld", (long) (obj>>8)&0xffffff);
 316             break;
 317     }
 318 }
 319
 320 static void brief_list(lispobj obj)
 321 {
 322     int space = 0;
 323     int length = 0;
 324
 325     if (!is_valid_lisp_addr((os_vm_address_t)native_pointer(obj)))
 326         printf("(invalid Lisp-level address)");
 327     else if (obj == NIL)
 328         printf("NIL");
 329     else {
 330         putchar('(');
 331         while (lowtag_of(obj) == LIST_POINTER_LOWTAG) {
 332             struct cons *cons = (struct cons *)native_pointer(obj);
 333
 334             if (space)
 335                 putchar(' ');
 336             if (++length >= max_length) {
 337                 printf("...");
 338                 obj = NIL;
 339                 break;
 340             }
 341             print_obj("", cons->car);
 342             obj = cons->cdr;
 343             space = 1;
 344             if (obj == NIL)
 345                 break;
 346         }
 347         if (obj != NIL) {
 348             printf(" . ");
 349             print_obj("", obj);
 350         }
 351         putchar(')');
 352     }
 353 }
 354
 355 #ifdef LISP_FEATURE_X86_64
 356 static void print_unknown(lispobj obj)
 357 {
 358   printf("unknown object: %p", (void *)obj);
 359 }
 360 #endif
 361
 362 static void print_list(lispobj obj)
 363 {
 364     if (!is_valid_lisp_addr((os_vm_address_t)native_pointer(obj))) {
 365         printf("(invalid address)");
 366     } else if (obj == NIL) {
 367         printf(" (NIL)");
 368     } else {
 369         struct cons *cons = (struct cons *)native_pointer(obj);
 370
 371         print_obj("car: ", cons->car);
 372         print_obj("cdr: ", cons->cdr);
 373     }
 374 }
 375
 376 static void brief_struct(lispobj obj)
 377 {
 378     printf("#<ptr to 0x%08lx instance>",
 379            (unsigned long) ((struct instance *)native_pointer(obj))->slots[0]);
 380 }
 381
 382 static void print_struct(lispobj obj)
 383 {
 384     struct instance *instance = (struct instance *)native_pointer(obj);
 385     unsigned int i;
 386     char buffer[16];
 387     print_obj("type: ", ((struct instance *)native_pointer(obj))->slots[0]);
 388     for (i = 1; i < HeaderValue(instance->header); i++) {
 389         sprintf(buffer, "slot %d: ", i);
 390         print_obj(buffer, instance->slots[i]);
 391     }
 392 }
 393
 394 static void brief_otherptr(lispobj obj)
 395 {
 396     lispobj *ptr, header;
 397     int type;
 398     struct symbol *symbol;
 399     struct vector *vector;
 400     char *charptr;
 401
 402     ptr = (lispobj *) native_pointer(obj);
 403
 404     if (!is_valid_lisp_addr((os_vm_address_t)obj)) {
 405             printf("(invalid address)");
 406             return;
 407     }
 408
 409     header = *ptr;
 410     type = widetag_of(header);
 411     switch (type) {
 412         case SYMBOL_HEADER_WIDETAG:
 413             symbol = (struct symbol *)ptr;
 414             vector = (struct vector *)native_pointer(symbol->name);
 415             for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
 416                 if (*charptr == '"')
 417                     putchar('\\');
 418                 putchar(*charptr);
 419             }
 420             break;
 421
 422         case SIMPLE_BASE_STRING_WIDETAG:
 423             vector = (struct vector *)ptr;
 424             putchar('"');
 425             for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
 426                 if (*charptr == '"')
 427                     putchar('\\');
 428                 putchar(*charptr);
 429             }
 430             putchar('"');
 431             break;
 432
 433         default:
 434             printf("#<ptr to ");
 435             brief_otherimm(header);
 436             putchar('>');
 437     }
 438 }
 439
 440 static void print_slots(char **slots, int count, lispobj *ptr)
 441 {
 442     while (count-- > 0) {
 443         if (*slots) {
 444             print_obj(*slots++, *ptr++);
 445         } else {
 446             print_obj("???: ", *ptr++);
 447         }
 448     }
 449 }
 450
 451 /* FIXME: Yikes again! This, like subtype_Names[], needs to depend
 452  * on the values in sbcl.h (or perhaps be generated automatically
 453  * by GENESIS as part of sbcl.h). */
 454 static char *symbol_slots[] = {"value: ", "hash: ",
 455     "plist: ", "name: ", "package: ",
 456 #ifdef LISP_FEATURE_SB_THREAD
 457     "tls-index: " ,
 458 #endif
 459     NULL};
 460 static char *ratio_slots[] = {"numer: ", "denom: ", NULL};
 461 static char *complex_slots[] = {"real: ", "imag: ", NULL};
 462 static char *code_slots[] = {"words: ", "entry: ", "debug: ", NULL};
 463 static char *fn_slots[] = {
 464     "self: ", "next: ", "name: ", "arglist: ", "type: ", NULL};
 465 static char *closure_slots[] = {"fn: ", NULL};
 466 static char *funcallable_instance_slots[] = {"fn: ", "lexenv: ", "layout: ", NULL};
 467 static char *weak_pointer_slots[] = {"value: ", NULL};
 468 static char *fdefn_slots[] = {"name: ", "function: ", "raw_addr: ", NULL};
 469 static char *value_cell_slots[] = {"value: ", NULL};
 470
 471 static void print_otherptr(lispobj obj)
 472 {
 473     if (!is_valid_lisp_addr((os_vm_address_t)obj)) {
 474         printf("(invalid address)");
 475     } else {
 476 #ifndef LISP_FEATURE_ALPHA
 477         lispobj *ptr;
 478         unsigned long header;
 479         unsigned long length;
 480 #else
 481         u32 *ptr;
 482         u32 header;
 483         u32 length;
 484 #endif
 485         int count, type, index;
 486         char *cptr, buffer[16];
 487
 488         ptr = (lispobj*) native_pointer(obj);
 489         if (ptr == NULL) {
 490                 printf(" (NULL Pointer)");
 491                 return;
 492         }
 493
 494         header = *ptr++;
 495         length = (*ptr) >> 2;
 496         count = header>>8;
 497         type = widetag_of(header);
 498
 499         print_obj("header: ", header);
 500         if (lowtag_of(header) != OTHER_IMMEDIATE_0_LOWTAG &&
 501             lowtag_of(header) != OTHER_IMMEDIATE_1_LOWTAG) {
 502             NEWLINE_OR_RETURN;
 503             printf("(invalid header object)");
 504             return;
 505         }
 506
 507         switch (type) {
 508             case BIGNUM_WIDETAG:
 509                 ptr += count;
 510                 NEWLINE_OR_RETURN;
 511                 printf("0x");
 512                 while (count-- > 0)
 513                     printf("%08lx", (unsigned long) *--ptr);
 514                 break;
 515
 516             case RATIO_WIDETAG:
 517                 print_slots(ratio_slots, count, ptr);
 518                 break;
 519
 520             case COMPLEX_WIDETAG:
 521                 print_slots(complex_slots, count, ptr);
 522                 break;
 523
 524             case SYMBOL_HEADER_WIDETAG:
 525                 print_slots(symbol_slots, count, ptr);
 526                 break;
 527
 528 #if N_WORD_BITS == 32
 529             case SINGLE_FLOAT_WIDETAG:
 530                 NEWLINE_OR_RETURN;
 531                 printf("%g", ((struct single_float *)native_pointer(obj))->value);
 532                 break;
 533 #endif
 534             case DOUBLE_FLOAT_WIDETAG:
 535                 NEWLINE_OR_RETURN;
 536                 printf("%g", ((struct double_float *)native_pointer(obj))->value);
 537                 break;
 538
 539 #ifdef LONG_FLOAT_WIDETAG
 540             case LONG_FLOAT_WIDETAG:
 541                 NEWLINE_OR_RETURN;
 542                 printf("%Lg", ((struct long_float *)native_pointer(obj))->value);
 543                 break;
 544 #endif
 545
 546 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
 547             case COMPLEX_SINGLE_FLOAT_WIDETAG:
 548                 NEWLINE_OR_RETURN;
 549                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->real);
 550                 NEWLINE_OR_RETURN;
 551                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->imag);
 552                 break;
 553 #endif
 554
 555 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
 556             case COMPLEX_DOUBLE_FLOAT_WIDETAG:
 557                 NEWLINE_OR_RETURN;
 558                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->real);
 559                 NEWLINE_OR_RETURN;
 560                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->imag);
 561                 break;
 562 #endif
 563
 564 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
 565             case COMPLEX_LONG_FLOAT_WIDETAG:
 566                 NEWLINE_OR_RETURN;
 567                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->real);
 568                 NEWLINE_OR_RETURN;
 569                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->imag);
 570                 break;
 571 #endif
 572
 573             case SIMPLE_BASE_STRING_WIDETAG:
 574 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
 575         case SIMPLE_CHARACTER_STRING_WIDETAG: /* FIXME */
 576 #endif
 577                 NEWLINE_OR_RETURN;
 578                 cptr = (char *)(ptr+1);
 579                 putchar('"');
 580                 while (length-- > 0)
 581                     putchar(*cptr++);
 582                 putchar('"');
 583                 break;
 584
 585             case SIMPLE_VECTOR_WIDETAG:
 586                 NEWLINE_OR_RETURN;
 587                 printf("length = %ld", length);
 588                 ptr++;
 589                 index = 0;
 590                 while (length-- > 0) {
 591                     sprintf(buffer, "%d: ", index++);
 592                     print_obj(buffer, *ptr++);
 593                 }
 594                 break;
 595
 596             case INSTANCE_HEADER_WIDETAG:
 597                 NEWLINE_OR_RETURN;
 598                 printf("length = %ld", (long) count);
 599                 index = 0;
 600                 while (count-- > 0) {
 601                     sprintf(buffer, "%d: ", index++);
 602                     print_obj(buffer, *ptr++);
 603                 }
 604                 break;
 605
 606             case SIMPLE_ARRAY_WIDETAG:
 607             case SIMPLE_BIT_VECTOR_WIDETAG:
 608             case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
 609             case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
 610             case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
 611             case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
 612             case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 613 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
 614             case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
 615 #endif
 616 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
 617             case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
 618 #endif
 619 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
 620             case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
 621 #endif
 622 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
 623             case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
 624 #endif
 625             case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
 626             case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
 627 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
 628             case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
 629 #endif
 630 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
 631             case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
 632 #endif
 633 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
 634             case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
 635 #endif
 636 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
 637             case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
 638 #endif
 639             case COMPLEX_BASE_STRING_WIDETAG:
 640 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
 641         case COMPLEX_CHARACTER_STRING_WIDETAG:
 642 #endif
 643             case COMPLEX_VECTOR_NIL_WIDETAG:
 644             case COMPLEX_BIT_VECTOR_WIDETAG:
 645             case COMPLEX_VECTOR_WIDETAG:
 646             case COMPLEX_ARRAY_WIDETAG:
 647                 break;
 648
 649             case CODE_HEADER_WIDETAG:
 650                 print_slots(code_slots, count-1, ptr);
 651                 break;
 652
 653             case SIMPLE_FUN_HEADER_WIDETAG:
 654                 print_slots(fn_slots, 5, ptr);
 655                 break;
 656
 657             case RETURN_PC_HEADER_WIDETAG:
 658                 print_obj("code: ", obj - (count * 4));
 659                 break;
 660
 661             case CLOSURE_HEADER_WIDETAG:
 662                 print_slots(closure_slots, count, ptr);
 663                 break;
 664
 665             case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
 666                 print_slots(funcallable_instance_slots, count, ptr);
 667                 break;
 668
 669             case VALUE_CELL_HEADER_WIDETAG:
 670                 print_slots(value_cell_slots, 1, ptr);
 671                 break;
 672
 673             case SAP_WIDETAG:
 674                 NEWLINE_OR_RETURN;
 675 #ifndef LISP_FEATURE_ALPHA
 676                 printf("0x%08lx", (unsigned long) *ptr);
 677 #else
 678                 printf("0x%016lx", *(lispobj*)(ptr+1));
 679 #endif
 680                 break;
 681
 682             case WEAK_POINTER_WIDETAG:
 683                 print_slots(weak_pointer_slots, 1, ptr);
 684                 break;
 685
 686             case CHARACTER_WIDETAG:
 687             case UNBOUND_MARKER_WIDETAG:
 688                 NEWLINE_OR_RETURN;
 689                 printf("pointer to an immediate?");
 690                 break;
 691
 692             case FDEFN_WIDETAG:
 693                 print_slots(fdefn_slots, count, ptr);
 694                 break;
 695
 696             default:
 697                 NEWLINE_OR_RETURN;
 698                 printf("Unknown header object?");
 699                 break;
 700         }
 701     }
 702 }
 703
 704 static void print_obj(char *prefix, lispobj obj)
 705 {
 706 #ifdef LISP_FEATURE_X86_64
 707     static void (*verbose_fns[])(lispobj obj)
 708         = {print_fixnum, print_struct, print_otherimm, print_unknown,
 709            print_unknown, print_unknown, print_otherimm, print_list,
 710            print_fixnum, print_otherptr, print_otherimm, print_unknown,
 711            print_unknown, print_unknown, print_otherimm, print_otherptr};
 712     static void (*brief_fns[])(lispobj obj)
 713         = {brief_fixnum, brief_struct, brief_otherimm, print_unknown,
 714            print_unknown,  print_unknown, brief_otherimm, brief_list,
 715            brief_fixnum, brief_otherptr, brief_otherimm, print_unknown,
 716            print_unknown,  print_unknown,brief_otherimm, brief_otherptr};
 717 #else
 718     static void (*verbose_fns[])(lispobj obj)
 719         = {print_fixnum, print_struct, print_otherimm, print_list,
 720            print_fixnum, print_otherptr, print_otherimm, print_otherptr};
 721     static void (*brief_fns[])(lispobj obj)
 722         = {brief_fixnum, brief_struct, brief_otherimm, brief_list,
 723            brief_fixnum, brief_otherptr, brief_otherimm, brief_otherptr};
 724 #endif
 725     int type = lowtag_of(obj);
 726     struct var *var = lookup_by_obj(obj);
 727     char buffer[256];
 728     boolean verbose = cur_depth < brief_depth;
 729
 730     if (!continue_p(verbose))
 731         return;
 732
 733     if (var != NULL && var_clock(var) == cur_clock)
 734         dont_descend = 1;
 735
 736     if (var == NULL &&
 737         ((obj & LOWTAG_MASK) == FUN_POINTER_LOWTAG ||
 738          (obj & LOWTAG_MASK) == LIST_POINTER_LOWTAG ||
 739          (obj & LOWTAG_MASK) == INSTANCE_POINTER_LOWTAG ||
 740          (obj & LOWTAG_MASK) == OTHER_POINTER_LOWTAG))
 741         var = define_var(NULL, obj, 0);
 742
 743     if (var != NULL)
 744         var_setclock(var, cur_clock);
 745
 746     cur_depth++;
 747     if (verbose) {
 748         if (var != NULL) {
 749             sprintf(buffer, "$%s=", var_name(var));
 750             newline(buffer);
 751         }
 752         else
 753             newline(NULL);
 754         printf("%s0x%08lx: ", prefix, (unsigned long) obj);
 755         if (cur_depth < brief_depth) {
 756             fputs(lowtag_Names[type], stdout);
 757             (*verbose_fns[type])(obj);
 758         }
 759         else
 760             (*brief_fns[type])(obj);
 761     }
 762     else {
 763         if (dont_descend)
 764             printf("$%s", var_name(var));
 765         else {
 766             if (var != NULL)
 767                 printf("$%s=", var_name(var));
 768             (*brief_fns[type])(obj);
 769         }
 770     }
 771     cur_depth--;
 772     dont_descend = 0;
 773 }
 774
 775 void reset_printer()
 776 {
 777     cur_clock++;
 778     cur_lines = 0;
 779     dont_descend = 0;
 780 }
 781
 782 void print(lispobj obj)
 783 {
 784     skip_newline = 1;
 785     cur_depth = 0;
 786     max_depth = 5;
 787     max_lines = 20;
 788
 789     print_obj("", obj);
 790
 791     putchar('\n');
 792 }
 793
 794 void brief_print(lispobj obj)
 795 {
 796     skip_newline = 1;
 797     cur_depth = 0;
 798     max_depth = 1;
 799     max_lines = 5000;
 800
 801     print_obj("", obj);
 802     putchar('\n');
 803 }
 804
 805 #else
 806
 807 void
 808 brief_print(lispobj obj)
 809 {
 810     printf("lispobj 0x%lx\n", (unsigned long)obj);
 811 }
 812
 813 #endif /* defined(LISP_FEATURE_SB_LDB) */