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