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             if (fgets(buffer, sizeof(buffer), stdin)) {
 199                 if (buffer[0] == 'n' || buffer[0] == 'N')
 200                     throw_to_monitor();
 201                 else
 202                     cur_lines = 0;
 203             } else {
 204                 printf("\nUnable to read response, assuming y.\n");
 205                 cur_lines = 0;
 206             }
 207         }
 208     }
 209
 210     return 1;
 211 }
 212
 213 static void newline(char *label)
 214 {
 215     cur_lines++;
 216     if (label != NULL)
 217         fputs(label, stdout);
 218     putchar('\t');
 219     indent(cur_depth * 2);
 220 }
 221
 222
 223 static void brief_fixnum(lispobj obj)
 224 {
 225 #ifndef LISP_FEATURE_ALPHA
 226     printf("%ld", ((long)obj)>>2);
 227 #else
 228     printf("%d", ((s32)obj)>>2);
 229 #endif
 230 }
 231
 232 static void print_fixnum(lispobj obj)
 233 {
 234 #ifndef LISP_FEATURE_ALPHA
 235     printf(": %ld", ((long)obj)>>2);
 236 #else
 237     printf(": %d", ((s32)obj)>>2);
 238 #endif
 239 }
 240
 241 static void brief_otherimm(lispobj obj)
 242 {
 243     int type, c;
 244     unsigned int idx;
 245     char buffer[10];
 246
 247     type = widetag_of(obj);
 248     switch (type) {
 249         case CHARACTER_WIDETAG:
 250             c = (obj>>8)&0xff;
 251             switch (c) {
 252                 case '\0':
 253                     printf("#\\Null");
 254                     break;
 255                 case '\n':
 256                     printf("#\\Newline");
 257                     break;
 258                 case '\b':
 259                     printf("#\\Backspace");
 260                     break;
 261                 case '\177':
 262                     printf("#\\Delete");
 263                     break;
 264                 default:
 265                     strcpy(buffer, "#\\");
 266                     if (c >= 128) {
 267                         strcat(buffer, "m-");
 268                         c -= 128;
 269                     }
 270                     if (c < 32) {
 271                         strcat(buffer, "c-");
 272                         c += '@';
 273                     }
 274                     printf("%s%c", buffer, c);
 275                     break;
 276             }
 277             break;
 278
 279         case UNBOUND_MARKER_WIDETAG:
 280             printf("<unbound marker>");
 281             break;
 282
 283         default:
 284             idx = type >> 2;
 285             if (idx < (sizeof(lowtag_Names) / sizeof(char *)))
 286                     printf("%s", lowtag_Names[idx]);
 287             else
 288                     printf("unknown type (0x%0x)", type);
 289             break;
 290     }
 291 }
 292
 293 static void print_otherimm(lispobj obj)
 294 {
 295     int type;
 296
 297     unsigned int idx;
 298
 299     type = widetag_of(obj);
 300     idx = type >> 2;
 301
 302     if (idx < (sizeof(lowtag_Names) / sizeof(char *)))
 303             printf(", %s", lowtag_Names[idx]);
 304     else
 305             printf(", unknown type (0x%0x)", type);
 306
 307     switch (widetag_of(obj)) {
 308         case CHARACTER_WIDETAG:
 309             printf(": ");
 310             brief_otherimm(obj);
 311             break;
 312
 313         case SAP_WIDETAG:
 314         case UNBOUND_MARKER_WIDETAG:
 315             break;
 316
 317         default:
 318             printf(": data=%ld", (long) (obj>>8)&0xffffff);
 319             break;
 320     }
 321 }
 322
 323 static void brief_list(lispobj obj)
 324 {
 325     int space = 0;
 326     int length = 0;
 327
 328     if (!is_valid_lisp_addr((os_vm_address_t)native_pointer(obj)))
 329         printf("(invalid Lisp-level address)");
 330     else if (obj == NIL)
 331         printf("NIL");
 332     else {
 333         putchar('(');
 334         while (lowtag_of(obj) == LIST_POINTER_LOWTAG) {
 335             struct cons *cons = (struct cons *)native_pointer(obj);
 336
 337             if (space)
 338                 putchar(' ');
 339             if (++length >= max_length) {
 340                 printf("...");
 341                 obj = NIL;
 342                 break;
 343             }
 344             print_obj("", cons->car);
 345             obj = cons->cdr;
 346             space = 1;
 347             if (obj == NIL)
 348                 break;
 349         }
 350         if (obj != NIL) {
 351             printf(" . ");
 352             print_obj("", obj);
 353         }
 354         putchar(')');
 355     }
 356 }
 357
 358 #ifdef LISP_FEATURE_X86_64
 359 static void print_unknown(lispobj obj)
 360 {
 361   printf("unknown object: %p", (void *)obj);
 362 }
 363 #endif
 364
 365 static void print_list(lispobj obj)
 366 {
 367     if (!is_valid_lisp_addr((os_vm_address_t)native_pointer(obj))) {
 368         printf("(invalid address)");
 369     } else if (obj == NIL) {
 370         printf(" (NIL)");
 371     } else {
 372         struct cons *cons = (struct cons *)native_pointer(obj);
 373
 374         print_obj("car: ", cons->car);
 375         print_obj("cdr: ", cons->cdr);
 376     }
 377 }
 378
 379 static void brief_struct(lispobj obj)
 380 {
 381     printf("#<ptr to 0x%08lx instance>",
 382            (unsigned long) ((struct instance *)native_pointer(obj))->slots[0]);
 383 }
 384
 385 static void print_struct(lispobj obj)
 386 {
 387     struct instance *instance = (struct instance *)native_pointer(obj);
 388     unsigned int i;
 389     char buffer[16];
 390     print_obj("type: ", ((struct instance *)native_pointer(obj))->slots[0]);
 391     for (i = 1; i < HeaderValue(instance->header); i++) {
 392         sprintf(buffer, "slot %d: ", i);
 393         print_obj(buffer, instance->slots[i]);
 394     }
 395 }
 396
 397 static void brief_otherptr(lispobj obj)
 398 {
 399     lispobj *ptr, header;
 400     int type;
 401     struct symbol *symbol;
 402     struct vector *vector;
 403     char *charptr;
 404
 405     ptr = (lispobj *) native_pointer(obj);
 406
 407     if (!is_valid_lisp_addr((os_vm_address_t)obj)) {
 408             printf("(invalid address)");
 409             return;
 410     }
 411
 412     header = *ptr;
 413     type = widetag_of(header);
 414     switch (type) {
 415         case SYMBOL_HEADER_WIDETAG:
 416             symbol = (struct symbol *)ptr;
 417             vector = (struct vector *)native_pointer(symbol->name);
 418             for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
 419                 if (*charptr == '"')
 420                     putchar('\\');
 421                 putchar(*charptr);
 422             }
 423             break;
 424
 425         case SIMPLE_BASE_STRING_WIDETAG:
 426             vector = (struct vector *)ptr;
 427             putchar('"');
 428             for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
 429                 if (*charptr == '"')
 430                     putchar('\\');
 431                 putchar(*charptr);
 432             }
 433             putchar('"');
 434             break;
 435
 436         default:
 437             printf("#<ptr to ");
 438             brief_otherimm(header);
 439             putchar('>');
 440     }
 441 }
 442
 443 static void print_slots(char **slots, int count, lispobj *ptr)
 444 {
 445     while (count-- > 0) {
 446         if (*slots) {
 447             print_obj(*slots++, *ptr++);
 448         } else {
 449             print_obj("???: ", *ptr++);
 450         }
 451     }
 452 }
 453
 454 /* FIXME: Yikes again! This, like subtype_Names[], needs to depend
 455  * on the values in sbcl.h (or perhaps be generated automatically
 456  * by GENESIS as part of sbcl.h). */
 457 static char *symbol_slots[] = {"value: ", "hash: ",
 458     "plist: ", "name: ", "package: ",
 459 #ifdef LISP_FEATURE_SB_THREAD
 460     "tls-index: " ,
 461 #endif
 462     NULL};
 463 static char *ratio_slots[] = {"numer: ", "denom: ", NULL};
 464 static char *complex_slots[] = {"real: ", "imag: ", NULL};
 465 static char *code_slots[] = {"words: ", "entry: ", "debug: ", NULL};
 466 static char *fn_slots[] = {
 467     "self: ", "next: ", "name: ", "arglist: ", "type: ", NULL};
 468 static char *closure_slots[] = {"fn: ", NULL};
 469 static char *funcallable_instance_slots[] = {"fn: ", "lexenv: ", "layout: ", NULL};
 470 static char *weak_pointer_slots[] = {"value: ", NULL};
 471 static char *fdefn_slots[] = {"name: ", "function: ", "raw_addr: ", NULL};
 472 static char *value_cell_slots[] = {"value: ", NULL};
 473
 474 static void print_otherptr(lispobj obj)
 475 {
 476     if (!is_valid_lisp_addr((os_vm_address_t)obj)) {
 477         printf("(invalid address)");
 478     } else {
 479 #ifndef LISP_FEATURE_ALPHA
 480         lispobj *ptr;
 481         unsigned long header;
 482         unsigned long length;
 483 #else
 484         u32 *ptr;
 485         u32 header;
 486         u32 length;
 487 #endif
 488         int count, type, index;
 489         char *cptr, buffer[16];
 490
 491         ptr = (lispobj*) native_pointer(obj);
 492         if (ptr == NULL) {
 493                 printf(" (NULL Pointer)");
 494                 return;
 495         }
 496
 497         header = *ptr++;
 498         length = (*ptr) >> 2;
 499         count = header>>8;
 500         type = widetag_of(header);
 501
 502         print_obj("header: ", header);
 503         if (lowtag_of(header) != OTHER_IMMEDIATE_0_LOWTAG &&
 504             lowtag_of(header) != OTHER_IMMEDIATE_1_LOWTAG) {
 505             NEWLINE_OR_RETURN;
 506             printf("(invalid header object)");
 507             return;
 508         }
 509
 510         switch (type) {
 511             case BIGNUM_WIDETAG:
 512                 ptr += count;
 513                 NEWLINE_OR_RETURN;
 514                 printf("0x");
 515                 while (count-- > 0)
 516                     printf("%08lx", (unsigned long) *--ptr);
 517                 break;
 518
 519             case RATIO_WIDETAG:
 520                 print_slots(ratio_slots, count, ptr);
 521                 break;
 522
 523             case COMPLEX_WIDETAG:
 524                 print_slots(complex_slots, count, ptr);
 525                 break;
 526
 527             case SYMBOL_HEADER_WIDETAG:
 528                 print_slots(symbol_slots, count, ptr);
 529                 break;
 530
 531 #if N_WORD_BITS == 32
 532             case SINGLE_FLOAT_WIDETAG:
 533                 NEWLINE_OR_RETURN;
 534                 printf("%g", ((struct single_float *)native_pointer(obj))->value);
 535                 break;
 536 #endif
 537             case DOUBLE_FLOAT_WIDETAG:
 538                 NEWLINE_OR_RETURN;
 539                 printf("%g", ((struct double_float *)native_pointer(obj))->value);
 540                 break;
 541
 542 #ifdef LONG_FLOAT_WIDETAG
 543             case LONG_FLOAT_WIDETAG:
 544                 NEWLINE_OR_RETURN;
 545                 printf("%Lg", ((struct long_float *)native_pointer(obj))->value);
 546                 break;
 547 #endif
 548
 549 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
 550             case COMPLEX_SINGLE_FLOAT_WIDETAG:
 551                 NEWLINE_OR_RETURN;
 552 #ifdef LISP_FEATURE_X86_64
 553                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->data.data[0]);
 554 #else
 555                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->real);
 556 #endif
 557                 NEWLINE_OR_RETURN;
 558 #ifdef LISP_FEATURE_X86_64
 559                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->data.data[1]);
 560 #else
 561                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->imag);
 562 #endif
 563                 break;
 564 #endif
 565
 566 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
 567             case COMPLEX_DOUBLE_FLOAT_WIDETAG:
 568                 NEWLINE_OR_RETURN;
 569                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->real);
 570                 NEWLINE_OR_RETURN;
 571                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->imag);
 572                 break;
 573 #endif
 574
 575 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
 576             case COMPLEX_LONG_FLOAT_WIDETAG:
 577                 NEWLINE_OR_RETURN;
 578                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->real);
 579                 NEWLINE_OR_RETURN;
 580                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->imag);
 581                 break;
 582 #endif
 583
 584             case SIMPLE_BASE_STRING_WIDETAG:
 585 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
 586         case SIMPLE_CHARACTER_STRING_WIDETAG: /* FIXME */
 587 #endif
 588                 NEWLINE_OR_RETURN;
 589                 cptr = (char *)(ptr+1);
 590                 putchar('"');
 591                 while (length-- > 0)
 592                     putchar(*cptr++);
 593                 putchar('"');
 594                 break;
 595
 596             case SIMPLE_VECTOR_WIDETAG:
 597                 NEWLINE_OR_RETURN;
 598                 printf("length = %ld", length);
 599                 ptr++;
 600                 index = 0;
 601                 while (length-- > 0) {
 602                     sprintf(buffer, "%d: ", index++);
 603                     print_obj(buffer, *ptr++);
 604                 }
 605                 break;
 606
 607             case INSTANCE_HEADER_WIDETAG:
 608                 NEWLINE_OR_RETURN;
 609                 printf("length = %ld", (long) count);
 610                 index = 0;
 611                 while (count-- > 0) {
 612                     sprintf(buffer, "%d: ", index++);
 613                     print_obj(buffer, *ptr++);
 614                 }
 615                 break;
 616
 617             case SIMPLE_ARRAY_WIDETAG:
 618             case SIMPLE_BIT_VECTOR_WIDETAG:
 619             case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
 620             case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
 621             case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
 622             case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
 623             case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 624 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
 625             case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
 626 #endif
 627 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
 628             case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
 629 #endif
 630 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
 631             case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
 632 #endif
 633 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
 634             case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
 635 #endif
 636             case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
 637             case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
 638 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
 639             case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
 640 #endif
 641 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
 642             case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
 643 #endif
 644 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
 645             case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
 646 #endif
 647 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
 648             case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
 649 #endif
 650             case COMPLEX_BASE_STRING_WIDETAG:
 651 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
 652         case COMPLEX_CHARACTER_STRING_WIDETAG:
 653 #endif
 654             case COMPLEX_VECTOR_NIL_WIDETAG:
 655             case COMPLEX_BIT_VECTOR_WIDETAG:
 656             case COMPLEX_VECTOR_WIDETAG:
 657             case COMPLEX_ARRAY_WIDETAG:
 658                 break;
 659
 660             case CODE_HEADER_WIDETAG:
 661                 print_slots(code_slots, count-1, ptr);
 662                 break;
 663
 664             case SIMPLE_FUN_HEADER_WIDETAG:
 665                 print_slots(fn_slots, 5, ptr);
 666                 break;
 667
 668             case RETURN_PC_HEADER_WIDETAG:
 669                 print_obj("code: ", obj - (count * 4));
 670                 break;
 671
 672             case CLOSURE_HEADER_WIDETAG:
 673                 print_slots(closure_slots, count, ptr);
 674                 break;
 675
 676             case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
 677                 print_slots(funcallable_instance_slots, count, ptr);
 678                 break;
 679
 680             case VALUE_CELL_HEADER_WIDETAG:
 681                 print_slots(value_cell_slots, 1, ptr);
 682                 break;
 683
 684             case SAP_WIDETAG:
 685                 NEWLINE_OR_RETURN;
 686 #ifndef LISP_FEATURE_ALPHA
 687                 printf("0x%08lx", (unsigned long) *ptr);
 688 #else
 689                 printf("0x%016lx", *(lispobj*)(ptr+1));
 690 #endif
 691                 break;
 692
 693             case WEAK_POINTER_WIDETAG:
 694                 print_slots(weak_pointer_slots, 1, ptr);
 695                 break;
 696
 697             case CHARACTER_WIDETAG:
 698             case UNBOUND_MARKER_WIDETAG:
 699                 NEWLINE_OR_RETURN;
 700                 printf("pointer to an immediate?");
 701                 break;
 702
 703             case FDEFN_WIDETAG:
 704                 print_slots(fdefn_slots, count, ptr);
 705                 break;
 706
 707             default:
 708                 NEWLINE_OR_RETURN;
 709                 printf("Unknown header object?");
 710                 break;
 711         }
 712     }
 713 }
 714
 715 static void print_obj(char *prefix, lispobj obj)
 716 {
 717 #ifdef LISP_FEATURE_X86_64
 718     static void (*verbose_fns[])(lispobj obj)
 719         = {print_fixnum, print_struct, print_otherimm, print_unknown,
 720            print_unknown, print_unknown, print_otherimm, print_list,
 721            print_fixnum, print_otherptr, print_otherimm, print_unknown,
 722            print_unknown, print_unknown, print_otherimm, print_otherptr};
 723     static void (*brief_fns[])(lispobj obj)
 724         = {brief_fixnum, brief_struct, brief_otherimm, print_unknown,
 725            print_unknown,  print_unknown, brief_otherimm, brief_list,
 726            brief_fixnum, brief_otherptr, brief_otherimm, print_unknown,
 727            print_unknown,  print_unknown,brief_otherimm, brief_otherptr};
 728 #else
 729     static void (*verbose_fns[])(lispobj obj)
 730         = {print_fixnum, print_struct, print_otherimm, print_list,
 731            print_fixnum, print_otherptr, print_otherimm, print_otherptr};
 732     static void (*brief_fns[])(lispobj obj)
 733         = {brief_fixnum, brief_struct, brief_otherimm, brief_list,
 734            brief_fixnum, brief_otherptr, brief_otherimm, brief_otherptr};
 735 #endif
 736     int type = lowtag_of(obj);
 737     struct var *var = lookup_by_obj(obj);
 738     char buffer[256];
 739     boolean verbose = cur_depth < brief_depth;
 740
 741     if (!continue_p(verbose))
 742         return;
 743
 744     if (var != NULL && var_clock(var) == cur_clock)
 745         dont_descend = 1;
 746
 747     if (var == NULL &&
 748         ((obj & LOWTAG_MASK) == FUN_POINTER_LOWTAG ||
 749          (obj & LOWTAG_MASK) == LIST_POINTER_LOWTAG ||
 750          (obj & LOWTAG_MASK) == INSTANCE_POINTER_LOWTAG ||
 751          (obj & LOWTAG_MASK) == OTHER_POINTER_LOWTAG))
 752         var = define_var(NULL, obj, 0);
 753
 754     if (var != NULL)
 755         var_setclock(var, cur_clock);
 756
 757     cur_depth++;
 758     if (verbose) {
 759         if (var != NULL) {
 760             sprintf(buffer, "$%s=", var_name(var));
 761             newline(buffer);
 762         }
 763         else
 764             newline(NULL);
 765         printf("%s0x%08lx: ", prefix, (unsigned long) obj);
 766         if (cur_depth < brief_depth) {
 767             fputs(lowtag_Names[type], stdout);
 768             (*verbose_fns[type])(obj);
 769         }
 770         else
 771             (*brief_fns[type])(obj);
 772     }
 773     else {
 774         if (dont_descend)
 775             printf("$%s", var_name(var));
 776         else {
 777             if (var != NULL)
 778                 printf("$%s=", var_name(var));
 779             (*brief_fns[type])(obj);
 780         }
 781     }
 782     cur_depth--;
 783     dont_descend = 0;
 784 }
 785
 786 void reset_printer()
 787 {
 788     cur_clock++;
 789     cur_lines = 0;
 790     dont_descend = 0;
 791 }
 792
 793 void print(lispobj obj)
 794 {
 795     skip_newline = 1;
 796     cur_depth = 0;
 797     max_depth = 5;
 798     max_lines = 20;
 799
 800     print_obj("", obj);
 801
 802     putchar('\n');
 803 }
 804
 805 void brief_print(lispobj obj)
 806 {
 807     skip_newline = 1;
 808     cur_depth = 0;
 809     max_depth = 1;
 810     max_lines = 5000;
 811
 812     print_obj("", obj);
 813     putchar('\n');
 814 }
 815
 816 #else
 817
 818 void
 819 brief_print(lispobj obj)
 820 {
 821     printf("lispobj 0x%lx\n", (unsigned long)obj);
 822 }
 823
 824 #endif /* defined(LISP_FEATURE_SB_LDB) */