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