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, idx;
 241     char buffer[10];
 242
 243     type = widetag_of(obj);
 244     switch (type) {
 245         case CHARACTER_WIDETAG:
 246             c = (obj>>8)&0xff;
 247             switch (c) {
 248                 case '\0':
 249                     printf("#\\Null");
 250                     break;
 251                 case '\n':
 252                     printf("#\\Newline");
 253                     break;
 254                 case '\b':
 255                     printf("#\\Backspace");
 256                     break;
 257                 case '\177':
 258                     printf("#\\Delete");
 259                     break;
 260                 default:
 261                     strcpy(buffer, "#\\");
 262                     if (c >= 128) {
 263                         strcat(buffer, "m-");
 264                         c -= 128;
 265                     }
 266                     if (c < 32) {
 267                         strcat(buffer, "c-");
 268                         c += '@';
 269                     }
 270                     printf("%s%c", buffer, c);
 271                     break;
 272             }
 273             break;
 274
 275         case UNBOUND_MARKER_WIDETAG:
 276             printf("<unbound marker>");
 277             break;
 278
 279         default:
 280             idx = type >> 2;
 281             if (idx < (sizeof(lowtag_Names) / sizeof(char *)))
 282                     printf("%s", lowtag_Names[idx]);
 283             else
 284                     printf("unknown type (0x%0x)", type);
 285             break;
 286     }
 287 }
 288
 289 static void print_otherimm(lispobj obj)
 290 {
 291     int type, idx;
 292
 293     type = widetag_of(obj);
 294     idx = type >> 2;
 295
 296     if (idx < (sizeof(lowtag_Names) / sizeof(char *)))
 297             printf(", %s", lowtag_Names[idx]);
 298     else
 299             printf(", unknown type (0x%0x)", type);
 300
 301     switch (widetag_of(obj)) {
 302         case CHARACTER_WIDETAG:
 303             printf(": ");
 304             brief_otherimm(obj);
 305             break;
 306
 307         case SAP_WIDETAG:
 308         case UNBOUND_MARKER_WIDETAG:
 309             break;
 310
 311         default:
 312             printf(": data=%ld", (long) (obj>>8)&0xffffff);
 313             break;
 314     }
 315 }
 316
 317 static void brief_list(lispobj obj)
 318 {
 319     int space = 0;
 320     int length = 0;
 321
 322     if (!is_valid_lisp_addr((os_vm_address_t)native_pointer(obj)))
 323         printf("(invalid Lisp-level address)");
 324     else if (obj == NIL)
 325         printf("NIL");
 326     else {
 327         putchar('(');
 328         while (lowtag_of(obj) == LIST_POINTER_LOWTAG) {
 329             struct cons *cons = (struct cons *)native_pointer(obj);
 330
 331             if (space)
 332                 putchar(' ');
 333             if (++length >= max_length) {
 334                 printf("...");
 335                 obj = NIL;
 336                 break;
 337             }
 338             print_obj(NULL, cons->car);
 339             obj = cons->cdr;
 340             space = 1;
 341             if (obj == NIL)
 342                 break;
 343         }
 344         if (obj != NIL) {
 345             printf(" . ");
 346             print_obj(NULL, obj);
 347         }
 348         putchar(')');
 349     }
 350 }
 351
 352 static void print_unknown(lispobj obj)
 353 {
 354     printf("unknown object: %p", (void *)obj);
 355 }
 356
 357 static void print_unknown(lispobj obj)
 358 {
 359   printf("unknown object: %p", (void *)obj);
 360 }
 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     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         /* FIXME: What does this "x & y & z & .." expression mean? */
 738         (obj & FUN_POINTER_LOWTAG & LIST_POINTER_LOWTAG & INSTANCE_POINTER_LOWTAG & OTHER_POINTER_LOWTAG) != 0)
 739         var = define_var(NULL, obj, 0);
 740
 741     if (var != NULL)
 742         var_setclock(var, cur_clock);
 743
 744     cur_depth++;
 745     if (verbose) {
 746         if (var != NULL) {
 747             sprintf(buffer, "$%s=", var_name(var));
 748             newline(buffer);
 749         }
 750         else
 751             newline(NULL);
 752         printf("%s0x%08lx: ", prefix, (unsigned long) obj);
 753         if (cur_depth < brief_depth) {
 754             fputs(lowtag_Names[type], stdout);
 755             (*verbose_fns[type])(obj);
 756         }
 757         else
 758             (*brief_fns[type])(obj);
 759     }
 760     else {
 761         if (dont_descend)
 762             printf("$%s", var_name(var));
 763         else {
 764             if (var != NULL)
 765                 printf("$%s=", var_name(var));
 766             (*brief_fns[type])(obj);
 767         }
 768     }
 769     cur_depth--;
 770     dont_descend = 0;
 771 }
 772
 773 void reset_printer()
 774 {
 775     cur_clock++;
 776     cur_lines = 0;
 777     dont_descend = 0;
 778 }
 779
 780 void print(lispobj obj)
 781 {
 782     skip_newline = 1;
 783     cur_depth = 0;
 784     max_depth = 5;
 785     max_lines = 20;
 786
 787     print_obj("", obj);
 788
 789     putchar('\n');
 790 }
 791
 792 void brief_print(lispobj obj)
 793 {
 794     skip_newline = 1;
 795     cur_depth = 0;
 796     max_depth = 1;
 797     max_lines = 5000;
 798
 799     print_obj("", obj);
 800     putchar('\n');
 801 }
 802
 803 #else
 804
 805 void
 806 brief_print(lispobj obj)
 807 {
 808     printf("lispobj 0x%lx\n", (unsigned long)obj);
 809 }
 810
 811 #endif /* defined(LISP_FEATURE_SB_LDB) */