src/runtime/print.c

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