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", obj);
 355 }
 356
 357 static void print_list(lispobj obj)
 358 {
 359     if (!is_valid_lisp_addr((os_vm_address_t)native_pointer(obj))) {
 360         printf("(invalid address)");
 361     } else if (obj == NIL) {
 362         printf(" (NIL)");
 363     } else {
 364         struct cons *cons = (struct cons *)native_pointer(obj);
 365
 366         print_obj("car: ", cons->car);
 367         print_obj("cdr: ", cons->cdr);
 368     }
 369 }
 370
 371 static void brief_struct(lispobj obj)
 372 {
 373     printf("#<ptr to 0x%08lx instance>",
 374            (unsigned long) ((struct instance *)native_pointer(obj))->slots[0]);
 375 }
 376
 377 static void print_struct(lispobj obj)
 378 {
 379     struct instance *instance = (struct instance *)native_pointer(obj);
 380     int i;
 381     char buffer[16];
 382     print_obj("type: ", ((struct instance *)native_pointer(obj))->slots[0]);
 383     for (i = 1; i < HeaderValue(instance->header); i++) {
 384         sprintf(buffer, "slot %d: ", i);
 385         print_obj(buffer, instance->slots[i]);
 386     }
 387 }
 388
 389 static void brief_otherptr(lispobj obj)
 390 {
 391     lispobj *ptr, header;
 392     int type;
 393     struct symbol *symbol;
 394     struct vector *vector;
 395     char *charptr;
 396
 397     ptr = (lispobj *) native_pointer(obj);
 398
 399     if (!is_valid_lisp_addr((os_vm_address_t)obj)) {
 400             printf("(invalid address)");
 401             return;
 402     }
 403
 404     header = *ptr;
 405     type = widetag_of(header);
 406     switch (type) {
 407         case SYMBOL_HEADER_WIDETAG:
 408             symbol = (struct symbol *)ptr;
 409             vector = (struct vector *)native_pointer(symbol->name);
 410             for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
 411                 if (*charptr == '"')
 412                     putchar('\\');
 413                 putchar(*charptr);
 414             }
 415             break;
 416
 417         case SIMPLE_BASE_STRING_WIDETAG:
 418             vector = (struct vector *)ptr;
 419             putchar('"');
 420             for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
 421                 if (*charptr == '"')
 422                     putchar('\\');
 423                 putchar(*charptr);
 424             }
 425             putchar('"');
 426             break;
 427
 428         default:
 429             printf("#<ptr to ");
 430             brief_otherimm(header);
 431             putchar('>');
 432     }
 433 }
 434
 435 static void print_slots(char **slots, int count, lispobj *ptr)
 436 {
 437     while (count-- > 0) {
 438         if (*slots) {
 439             print_obj(*slots++, *ptr++);
 440         } else {
 441             print_obj("???: ", *ptr++);
 442         }
 443     }
 444 }
 445
 446 /* FIXME: Yikes again! This, like subtype_Names[], needs to depend
 447  * on the values in sbcl.h (or perhaps be generated automatically
 448  * by GENESIS as part of sbcl.h). */
 449 static char *symbol_slots[] = {"value: ", "hash: ",
 450     "plist: ", "name: ", "package: ",
 451 #ifdef LISP_FEATURE_SB_THREAD
 452     "tls-index: " ,
 453 #endif
 454     NULL};
 455 static char *ratio_slots[] = {"numer: ", "denom: ", NULL};
 456 static char *complex_slots[] = {"real: ", "imag: ", NULL};
 457 static char *code_slots[] = {"words: ", "entry: ", "debug: ", NULL};
 458 static char *fn_slots[] = {
 459     "self: ", "next: ", "name: ", "arglist: ", "type: ", NULL};
 460 static char *closure_slots[] = {"fn: ", NULL};
 461 static char *funcallable_instance_slots[] = {"fn: ", "lexenv: ", "layout: ", NULL};
 462 static char *weak_pointer_slots[] = {"value: ", NULL};
 463 static char *fdefn_slots[] = {"name: ", "function: ", "raw_addr: ", NULL};
 464 static char *value_cell_slots[] = {"value: ", NULL};
 465
 466 static void print_otherptr(lispobj obj)
 467 {
 468     if (!is_valid_lisp_addr((os_vm_address_t)obj)) {
 469         printf("(invalid address)");
 470     } else {
 471 #ifndef LISP_FEATURE_ALPHA
 472         lispobj *ptr;
 473         unsigned long header;
 474         unsigned long length;
 475 #else
 476         u32 *ptr;
 477         u32 header;
 478         u32 length;
 479 #endif
 480         int count, type, index;
 481         char *cptr, buffer[16];
 482
 483         ptr = (lispobj*) native_pointer(obj);
 484         if (ptr == NULL) {
 485                 printf(" (NULL Pointer)");
 486                 return;
 487         }
 488
 489         header = *ptr++;
 490         length = (*ptr) >> 2;
 491         count = header>>8;
 492         type = widetag_of(header);
 493
 494         print_obj("header: ", header);
 495         if (lowtag_of(header) != OTHER_IMMEDIATE_0_LOWTAG &&
 496             lowtag_of(header) != OTHER_IMMEDIATE_1_LOWTAG) {
 497             NEWLINE_OR_RETURN;
 498             printf("(invalid header object)");
 499             return;
 500         }
 501
 502         switch (type) {
 503             case BIGNUM_WIDETAG:
 504                 ptr += count;
 505                 NEWLINE_OR_RETURN;
 506                 printf("0x");
 507                 while (count-- > 0)
 508                     printf("%08lx", (unsigned long) *--ptr);
 509                 break;
 510
 511             case RATIO_WIDETAG:
 512                 print_slots(ratio_slots, count, ptr);
 513                 break;
 514
 515             case COMPLEX_WIDETAG:
 516                 print_slots(complex_slots, count, ptr);
 517                 break;
 518
 519             case SYMBOL_HEADER_WIDETAG:
 520                 print_slots(symbol_slots, count, ptr);
 521                 break;
 522
 523 #if N_WORD_BITS == 32
 524             case SINGLE_FLOAT_WIDETAG:
 525                 NEWLINE_OR_RETURN;
 526                 printf("%g", ((struct single_float *)native_pointer(obj))->value);
 527                 break;
 528 #endif
 529             case DOUBLE_FLOAT_WIDETAG:
 530                 NEWLINE_OR_RETURN;
 531                 printf("%g", ((struct double_float *)native_pointer(obj))->value);
 532                 break;
 533
 534 #ifdef LONG_FLOAT_WIDETAG
 535             case LONG_FLOAT_WIDETAG:
 536                 NEWLINE_OR_RETURN;
 537                 printf("%Lg", ((struct long_float *)native_pointer(obj))->value);
 538                 break;
 539 #endif
 540
 541 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
 542             case COMPLEX_SINGLE_FLOAT_WIDETAG:
 543                 NEWLINE_OR_RETURN;
 544                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->real);
 545                 NEWLINE_OR_RETURN;
 546                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->imag);
 547                 break;
 548 #endif
 549
 550 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
 551             case COMPLEX_DOUBLE_FLOAT_WIDETAG:
 552                 NEWLINE_OR_RETURN;
 553                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->real);
 554                 NEWLINE_OR_RETURN;
 555                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->imag);
 556                 break;
 557 #endif
 558
 559 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
 560             case COMPLEX_LONG_FLOAT_WIDETAG:
 561                 NEWLINE_OR_RETURN;
 562                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->real);
 563                 NEWLINE_OR_RETURN;
 564                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->imag);
 565                 break;
 566 #endif
 567
 568             case SIMPLE_BASE_STRING_WIDETAG:
 569 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
 570         case SIMPLE_CHARACTER_STRING_WIDETAG: /* FIXME */
 571 #endif
 572                 NEWLINE_OR_RETURN;
 573                 cptr = (char *)(ptr+1);
 574                 putchar('"');
 575                 while (length-- > 0)
 576                     putchar(*cptr++);
 577                 putchar('"');
 578                 break;
 579
 580             case SIMPLE_VECTOR_WIDETAG:
 581                 NEWLINE_OR_RETURN;
 582                 printf("length = %ld", length);
 583                 ptr++;
 584                 index = 0;
 585                 while (length-- > 0) {
 586                     sprintf(buffer, "%d: ", index++);
 587                     print_obj(buffer, *ptr++);
 588                 }
 589                 break;
 590
 591             case INSTANCE_HEADER_WIDETAG:
 592                 NEWLINE_OR_RETURN;
 593                 printf("length = %ld", (long) count);
 594                 index = 0;
 595                 while (count-- > 0) {
 596                     sprintf(buffer, "%d: ", index++);
 597                     print_obj(buffer, *ptr++);
 598                 }
 599                 break;
 600
 601             case SIMPLE_ARRAY_WIDETAG:
 602             case SIMPLE_BIT_VECTOR_WIDETAG:
 603             case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
 604             case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
 605             case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
 606             case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
 607             case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 608 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
 609             case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
 610 #endif
 611 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
 612             case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
 613 #endif
 614 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
 615             case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
 616 #endif
 617 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
 618             case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
 619 #endif
 620             case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
 621             case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
 622 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
 623             case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
 624 #endif
 625 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
 626             case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
 627 #endif
 628 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
 629             case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
 630 #endif
 631 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
 632             case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
 633 #endif
 634             case COMPLEX_BASE_STRING_WIDETAG:
 635 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
 636         case COMPLEX_CHARACTER_STRING_WIDETAG:
 637 #endif
 638             case COMPLEX_VECTOR_NIL_WIDETAG:
 639             case COMPLEX_BIT_VECTOR_WIDETAG:
 640             case COMPLEX_VECTOR_WIDETAG:
 641             case COMPLEX_ARRAY_WIDETAG:
 642                 break;
 643
 644             case CODE_HEADER_WIDETAG:
 645                 print_slots(code_slots, count-1, ptr);
 646                 break;
 647
 648             case SIMPLE_FUN_HEADER_WIDETAG:
 649                 print_slots(fn_slots, 5, ptr);
 650                 break;
 651
 652             case RETURN_PC_HEADER_WIDETAG:
 653                 print_obj("code: ", obj - (count * 4));
 654                 break;
 655
 656             case CLOSURE_HEADER_WIDETAG:
 657                 print_slots(closure_slots, count, ptr);
 658                 break;
 659
 660             case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
 661                 print_slots(funcallable_instance_slots, count, ptr);
 662                 break;
 663
 664             case VALUE_CELL_HEADER_WIDETAG:
 665                 print_slots(value_cell_slots, 1, ptr);
 666                 break;
 667
 668             case SAP_WIDETAG:
 669                 NEWLINE_OR_RETURN;
 670 #ifndef LISP_FEATURE_ALPHA
 671                 printf("0x%08lx", (unsigned long) *ptr);
 672 #else
 673                 printf("0x%016lx", *(lispobj*)(ptr+1));
 674 #endif
 675                 break;
 676
 677             case WEAK_POINTER_WIDETAG:
 678                 print_slots(weak_pointer_slots, 1, ptr);
 679                 break;
 680
 681             case CHARACTER_WIDETAG:
 682             case UNBOUND_MARKER_WIDETAG:
 683                 NEWLINE_OR_RETURN;
 684                 printf("pointer to an immediate?");
 685                 break;
 686
 687             case FDEFN_WIDETAG:
 688                 print_slots(fdefn_slots, count, ptr);
 689                 break;
 690
 691             default:
 692                 NEWLINE_OR_RETURN;
 693                 printf("Unknown header object?");
 694                 break;
 695         }
 696     }
 697 }
 698
 699 static void print_obj(char *prefix, lispobj obj)
 700 {
 701 #ifdef LISP_FEATURE_X86_64
 702     static void (*verbose_fns[])(lispobj obj)
 703         = {print_fixnum, print_struct, print_otherimm, print_unknown,
 704            print_unknown, print_unknown, print_otherimm, print_list,
 705            print_fixnum, print_otherptr, print_otherimm, print_unknown,
 706            print_unknown, print_unknown, print_otherimm, print_otherptr};
 707     static void (*brief_fns[])(lispobj obj)
 708         = {brief_fixnum, brief_struct, brief_otherimm, print_unknown,
 709            print_unknown,  print_unknown, brief_otherimm, brief_list,
 710            brief_fixnum, brief_otherptr, brief_otherimm, print_unknown,
 711            print_unknown,  print_unknown,brief_otherimm, brief_otherptr};
 712 #else
 713     static void (*verbose_fns[])(lispobj obj)
 714         = {print_fixnum, print_struct, print_otherimm, print_list,
 715            print_fixnum, print_otherptr, print_otherimm, print_otherptr};
 716     static void (*brief_fns[])(lispobj obj)
 717         = {brief_fixnum, brief_struct, brief_otherimm, brief_list,
 718            brief_fixnum, brief_otherptr, brief_otherimm, brief_otherptr};
 719 #endif
 720     int type = lowtag_of(obj);
 721     struct var *var = lookup_by_obj(obj);
 722     char buffer[256];
 723     boolean verbose = cur_depth < brief_depth;
 724
 725     if (!continue_p(verbose))
 726         return;
 727
 728     if (var != NULL && var_clock(var) == cur_clock)
 729         dont_descend = 1;
 730
 731     if (var == NULL &&
 732         /* FIXME: What does this "x & y & z & .." expression mean? */
 733         (obj & FUN_POINTER_LOWTAG & LIST_POINTER_LOWTAG & INSTANCE_POINTER_LOWTAG & OTHER_POINTER_LOWTAG) != 0)
 734         var = define_var(NULL, obj, 0);
 735
 736     if (var != NULL)
 737         var_setclock(var, cur_clock);
 738
 739     cur_depth++;
 740     if (verbose) {
 741         if (var != NULL) {
 742             sprintf(buffer, "$%s=", var_name(var));
 743             newline(buffer);
 744         }
 745         else
 746             newline(NULL);
 747         printf("%s0x%08lx: ", prefix, (unsigned long) obj);
 748         if (cur_depth < brief_depth) {
 749             fputs(lowtag_Names[type], stdout);
 750             (*verbose_fns[type])(obj);
 751         }
 752         else
 753             (*brief_fns[type])(obj);
 754     }
 755     else {
 756         if (dont_descend)
 757             printf("$%s", var_name(var));
 758         else {
 759             if (var != NULL)
 760                 printf("$%s=", var_name(var));
 761             (*brief_fns[type])(obj);
 762         }
 763     }
 764     cur_depth--;
 765     dont_descend = 0;
 766 }
 767
 768 void reset_printer()
 769 {
 770     cur_clock++;
 771     cur_lines = 0;
 772     dont_descend = 0;
 773 }
 774
 775 void print(lispobj obj)
 776 {
 777     skip_newline = 1;
 778     cur_depth = 0;
 779     max_depth = 5;
 780     max_lines = 20;
 781
 782     print_obj("", obj);
 783
 784     putchar('\n');
 785 }
 786
 787 void brief_print(lispobj obj)
 788 {
 789     skip_newline = 1;
 790     cur_depth = 0;
 791     max_depth = 1;
 792     max_lines = 5000;
 793
 794     print_obj("", obj);
 795     putchar('\n');
 796 }
 797
 798 #else
 799
 800 void
 801 brief_print(lispobj obj)
 802 {
 803     printf("lispobj 0x%lx\n", (unsigned long)obj);
 804 }
 805
 806 #endif /* defined(LISP_FEATURE_SB_LDB) */