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