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 "print.h"
  24 #include "runtime.h"
  25 #include "sbcl.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 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 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 BASE_CHAR_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 BASE_CHAR_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 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             case SINGLE_FLOAT_WIDETAG:
 495                 NEWLINE_OR_RETURN;
 496                 printf("%g", ((struct single_float *)native_pointer(obj))->value);
 497                 break;
 498
 499             case DOUBLE_FLOAT_WIDETAG:
 500                 NEWLINE_OR_RETURN;
 501                 printf("%g", ((struct double_float *)native_pointer(obj))->value);
 502                 break;
 503
 504 #ifdef LONG_FLOAT_WIDETAG
 505             case LONG_FLOAT_WIDETAG:
 506                 NEWLINE_OR_RETURN;
 507                 printf("%Lg", ((struct long_float *)native_pointer(obj))->value);
 508                 break;
 509 #endif
 510
 511 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
 512             case COMPLEX_SINGLE_FLOAT_WIDETAG:
 513                 NEWLINE_OR_RETURN;
 514                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->real);
 515                 NEWLINE_OR_RETURN;
 516                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->imag);
 517                 break;
 518 #endif
 519
 520 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
 521             case COMPLEX_DOUBLE_FLOAT_WIDETAG:
 522                 NEWLINE_OR_RETURN;
 523                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->real);
 524                 NEWLINE_OR_RETURN;
 525                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->imag);
 526                 break;
 527 #endif
 528
 529 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
 530             case COMPLEX_LONG_FLOAT_WIDETAG:
 531                 NEWLINE_OR_RETURN;
 532                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->real);
 533                 NEWLINE_OR_RETURN;
 534                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->imag);
 535                 break;
 536 #endif
 537
 538             case SIMPLE_BASE_STRING_WIDETAG:
 539                 NEWLINE_OR_RETURN;
 540                 cptr = (char *)(ptr+1);
 541                 putchar('"');
 542                 while (length-- > 0)
 543                     putchar(*cptr++);
 544                 putchar('"');
 545                 break;
 546
 547             case SIMPLE_VECTOR_WIDETAG:
 548                 NEWLINE_OR_RETURN;
 549                 printf("length = %ld", length);
 550                 ptr++;
 551                 index = 0;
 552                 while (length-- > 0) {
 553                     sprintf(buffer, "%d: ", index++);
 554                     print_obj(buffer, *ptr++);
 555                 }
 556                 break;
 557
 558             case INSTANCE_HEADER_WIDETAG:
 559                 NEWLINE_OR_RETURN;
 560                 printf("length = %ld", (long) count);
 561                 index = 0;
 562                 while (count-- > 0) {
 563                     sprintf(buffer, "%d: ", index++);
 564                     print_obj(buffer, *ptr++);
 565                 }
 566                 break;
 567
 568             case SIMPLE_ARRAY_WIDETAG:
 569             case SIMPLE_BIT_VECTOR_WIDETAG:
 570             case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
 571             case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
 572             case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
 573             case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
 574             case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 575 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
 576             case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
 577 #endif
 578 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
 579             case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
 580 #endif
 581 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
 582             case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
 583 #endif
 584 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
 585             case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
 586 #endif
 587             case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
 588             case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
 589 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
 590             case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
 591 #endif
 592 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
 593             case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
 594 #endif
 595 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
 596             case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
 597 #endif
 598 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
 599             case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
 600 #endif
 601             case COMPLEX_BASE_STRING_WIDETAG:
 602             case COMPLEX_VECTOR_NIL_WIDETAG:
 603             case COMPLEX_BIT_VECTOR_WIDETAG:
 604             case COMPLEX_VECTOR_WIDETAG:
 605             case COMPLEX_ARRAY_WIDETAG:
 606                 break;
 607
 608             case CODE_HEADER_WIDETAG:
 609                 print_slots(code_slots, count-1, ptr);
 610                 break;
 611
 612             case SIMPLE_FUN_HEADER_WIDETAG:
 613                 print_slots(fn_slots, 5, ptr);
 614                 break;
 615
 616             case RETURN_PC_HEADER_WIDETAG:
 617                 print_obj("code: ", obj - (count * 4));
 618                 break;
 619
 620             case CLOSURE_HEADER_WIDETAG:
 621                 print_slots(closure_slots, count, ptr);
 622                 break;
 623
 624             case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
 625                 print_slots(funcallable_instance_slots, count, ptr);
 626                 break;
 627
 628             case VALUE_CELL_HEADER_WIDETAG:
 629                 print_slots(value_cell_slots, 1, ptr);
 630                 break;
 631
 632             case SAP_WIDETAG:
 633                 NEWLINE_OR_RETURN;
 634 #ifndef alpha
 635                 printf("0x%08lx", (unsigned long) *ptr);
 636 #else
 637                 printf("0x%016lx", *(lispobj*)(ptr+1));
 638 #endif
 639                 break;
 640
 641             case WEAK_POINTER_WIDETAG:
 642                 print_slots(weak_pointer_slots, 1, ptr);
 643                 break;
 644
 645             case BASE_CHAR_WIDETAG:
 646             case UNBOUND_MARKER_WIDETAG:
 647                 NEWLINE_OR_RETURN;
 648                 printf("pointer to an immediate?");
 649                 break;
 650
 651             case FDEFN_WIDETAG:
 652                 print_slots(fdefn_slots, count, ptr);
 653                 break;
 654
 655             default:
 656                 NEWLINE_OR_RETURN;
 657                 printf("Unknown header object?");
 658                 break;
 659         }
 660     }
 661 }
 662
 663 static void print_obj(char *prefix, lispobj obj)
 664 {
 665     static void (*verbose_fns[])(lispobj obj)
 666         = {print_fixnum, print_struct, print_otherimm, print_list,
 667            print_fixnum, print_otherptr, print_otherimm, print_otherptr};
 668     static void (*brief_fns[])(lispobj obj)
 669         = {brief_fixnum, brief_struct, brief_otherimm, brief_list,
 670            brief_fixnum, brief_otherptr, brief_otherimm, brief_otherptr};
 671     int type = lowtag_of(obj);
 672     struct var *var = lookup_by_obj(obj);
 673     char buffer[256];
 674     boolean verbose = cur_depth < brief_depth;
 675
 676     if (!continue_p(verbose))
 677         return;
 678
 679     if (var != NULL && var_clock(var) == cur_clock)
 680         dont_descend = 1;
 681
 682     if (var == NULL &&
 683         /* FIXME: What does this "x & y & z & .." expression mean? */
 684         (obj & FUN_POINTER_LOWTAG & LIST_POINTER_LOWTAG & INSTANCE_POINTER_LOWTAG & OTHER_POINTER_LOWTAG) != 0)
 685         var = define_var(NULL, obj, 0);
 686
 687     if (var != NULL)
 688         var_setclock(var, cur_clock);
 689
 690     cur_depth++;
 691     if (verbose) {
 692         if (var != NULL) {
 693             sprintf(buffer, "$%s=", var_name(var));
 694             newline(buffer);
 695         }
 696         else
 697             newline(NULL);
 698         printf("%s0x%08lx: ", prefix, (unsigned long) obj);
 699         if (cur_depth < brief_depth) {
 700             fputs(lowtag_Names[type], stdout);
 701             (*verbose_fns[type])(obj);
 702         }
 703         else
 704             (*brief_fns[type])(obj);
 705     }
 706     else {
 707         if (dont_descend)
 708             printf("$%s", var_name(var));
 709         else {
 710             if (var != NULL)
 711                 printf("$%s=", var_name(var));
 712             (*brief_fns[type])(obj);
 713         }
 714     }
 715     cur_depth--;
 716     dont_descend = 0;
 717 }
 718
 719 void reset_printer()
 720 {
 721     cur_clock++;
 722     cur_lines = 0;
 723     dont_descend = 0;
 724 }
 725
 726 void print(lispobj obj)
 727 {
 728     skip_newline = 1;
 729     cur_depth = 0;
 730     max_depth = 5;
 731     max_lines = 20;
 732
 733     print_obj("", obj);
 734
 735     putchar('\n');
 736 }
 737
 738 void brief_print(lispobj obj)
 739 {
 740     skip_newline = 1;
 741     cur_depth = 0;
 742     max_depth = 1;
 743     max_lines = 5000;
 744
 745     print_obj("", obj);
 746     putchar('\n');
 747 }
 748
 749 #else
 750
 751 void
 752 brief_print(lispobj obj)
 753 {
 754     printf("lispobj 0x%lx\n", (unsigned long)obj);
 755 }
 756
 757 #endif /* defined(LISP_FEATURE_SB_LDB) */