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