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 int cur_clock = 0;
  38
  39 static void print_obj(char *prefix, lispobj obj);
  40
  41 #define NEWLINE_OR_RETURN 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", (long) (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            (unsigned long) ((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_OR_RETURN;
 454             printf("(invalid header object)");
 455             return;
 456         }
 457
 458         switch (type) {
 459             case type_Bignum:
 460                 ptr += count;
 461                 NEWLINE_OR_RETURN;
 462                 printf("0x");
 463                 while (count-- > 0)
 464                     printf("%08lx", (unsigned long) *--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_OR_RETURN;
 481                 printf("%g", ((struct single_float *)PTR(obj))->value);
 482                 break;
 483
 484             case type_DoubleFloat:
 485                 NEWLINE_OR_RETURN;
 486                 printf("%g", ((struct double_float *)PTR(obj))->value);
 487                 break;
 488
 489 #ifdef type_LongFloat
 490             case type_LongFloat:
 491                 NEWLINE_OR_RETURN;
 492                 printf("%Lg", ((struct long_float *)PTR(obj))->value);
 493                 break;
 494 #endif
 495
 496 #ifdef type_ComplexSingleFloat
 497             case type_ComplexSingleFloat:
 498                 NEWLINE_OR_RETURN;
 499                 printf("%g", ((struct complex_single_float *)PTR(obj))->real);
 500                 NEWLINE_OR_RETURN;
 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_OR_RETURN;
 508                 printf("%g", ((struct complex_double_float *)PTR(obj))->real);
 509                 NEWLINE_OR_RETURN;
 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_OR_RETURN;
 517                 printf("%Lg", ((struct complex_long_float *)PTR(obj))->real);
 518                 NEWLINE_OR_RETURN;
 519                 printf("%Lg", ((struct complex_long_float *)PTR(obj))->imag);
 520                 break;
 521 #endif
 522
 523             case type_SimpleString:
 524                 NEWLINE_OR_RETURN;
 525                 cptr = (char *)(ptr+1);
 526                 putchar('"');
 527                 while (length-- > 0)
 528                     putchar(*cptr++);
 529                 putchar('"');
 530                 break;
 531
 532             case type_SimpleVector:
 533                 NEWLINE_OR_RETURN;
 534                 printf("length = %ld", length);
 535                 ptr++;
 536                 index = 0;
 537                 while (length-- > 0) {
 538                     sprintf(buffer, "%d: ", index++);
 539                     print_obj(buffer, *ptr++);
 540                 }
 541                 break;
 542
 543             case type_InstanceHeader:
 544                 NEWLINE_OR_RETURN;
 545                 printf("length = %ld", (long) count);
 546                 index = 0;
 547                 while (count-- > 0) {
 548                     sprintf(buffer, "%d: ", index++);
 549                     print_obj(buffer, *ptr++);
 550                 }
 551                 break;
 552
 553             case type_SimpleArray:
 554             case type_SimpleBitVector:
 555             case type_SimpleArrayUnsignedByte2:
 556             case type_SimpleArrayUnsignedByte4:
 557             case type_SimpleArrayUnsignedByte8:
 558             case type_SimpleArrayUnsignedByte16:
 559             case type_SimpleArrayUnsignedByte32:
 560 #ifdef type_SimpleArraySignedByte8
 561             case type_SimpleArraySignedByte8:
 562 #endif
 563 #ifdef type_SimpleArraySignedByte16
 564             case type_SimpleArraySignedByte16:
 565 #endif
 566 #ifdef type_SimpleArraySignedByte30
 567             case type_SimpleArraySignedByte30:
 568 #endif
 569 #ifdef type_SimpleArraySignedByte32
 570             case type_SimpleArraySignedByte32:
 571 #endif
 572             case type_SimpleArraySingleFloat:
 573             case type_SimpleArrayDoubleFloat:
 574 #ifdef type_SimpleArrayLongFloat
 575             case type_SimpleArrayLongFloat:
 576 #endif
 577 #ifdef type_SimpleArrayComplexSingleFloat
 578             case type_SimpleArrayComplexSingleFloat:
 579 #endif
 580 #ifdef type_SimpleArrayComplexDoubleFloat
 581             case type_SimpleArrayComplexDoubleFloat:
 582 #endif
 583 #ifdef type_SimpleArrayComplexLongFloat
 584             case type_SimpleArrayComplexLongFloat:
 585 #endif
 586             case type_ComplexString:
 587             case type_ComplexBitVector:
 588             case type_ComplexVector:
 589             case type_ComplexArray:
 590                 break;
 591
 592             case type_CodeHeader:
 593                 print_slots(code_slots, count-1, ptr);
 594                 break;
 595
 596             case type_FunctionHeader:
 597             case type_ClosureFunctionHeader:
 598                 print_slots(fn_slots, 5, ptr);
 599                 break;
 600
 601             case type_ReturnPcHeader:
 602                 print_obj("code: ", obj - (count * 4));
 603                 break;
 604
 605             case type_ClosureHeader:
 606                 print_slots(closure_slots, count, ptr);
 607                 break;
 608
 609             case type_FuncallableInstanceHeader:
 610                 print_slots(funcallable_instance_slots, count, ptr);
 611                 break;
 612
 613             case type_ValueCellHeader:
 614                 print_slots(value_cell_slots, 1, ptr);
 615                 break;
 616
 617             case type_Sap:
 618                 NEWLINE_OR_RETURN;
 619 #ifndef alpha
 620                 printf("0x%08lx", (unsigned long) *ptr);
 621 #else
 622                 printf("0x%016lx", *(lispobj*)(ptr+1));
 623 #endif
 624                 break;
 625
 626             case type_WeakPointer:
 627                 print_slots(weak_pointer_slots, 1, ptr);
 628                 break;
 629
 630             case type_BaseChar:
 631             case type_UnboundMarker:
 632                 NEWLINE_OR_RETURN;
 633                 printf("pointer to an immediate?");
 634                 break;
 635
 636             case type_Fdefn:
 637                 print_slots(fdefn_slots, count, ptr);
 638                 break;
 639
 640             default:
 641                 NEWLINE_OR_RETURN;
 642                 printf("Unknown header object?");
 643                 break;
 644         }
 645     }
 646 }
 647
 648 static void print_obj(char *prefix, lispobj obj)
 649 {
 650     static void (*verbose_fns[])(lispobj obj)
 651         = {print_fixnum, print_otherptr, print_otherimm, print_list,
 652            print_fixnum, print_struct, print_otherimm, print_otherptr};
 653     static void (*brief_fns[])(lispobj obj)
 654         = {brief_fixnum, brief_otherptr, brief_otherimm, brief_list,
 655            brief_fixnum, brief_struct, brief_otherimm, brief_otherptr};
 656     int type = LowtagOf(obj);
 657     struct var *var = lookup_by_obj(obj);
 658     char buffer[256];
 659     boolean verbose = cur_depth < brief_depth;
 660
 661
 662     if (!continue_p(verbose))
 663         return;
 664
 665     if (var != NULL && var_clock(var) == cur_clock)
 666         dont_descend = 1;
 667
 668     if (var == NULL && (obj & type_FunctionPointer & type_ListPointer & type_InstancePointer & type_OtherPointer) != 0)
 669         var = define_var(NULL, obj, 0);
 670
 671     if (var != NULL)
 672         var_setclock(var, cur_clock);
 673
 674     cur_depth++;
 675     if (verbose) {
 676         if (var != NULL) {
 677             sprintf(buffer, "$%s=", var_name(var));
 678             newline(buffer);
 679         }
 680         else
 681             newline(NULL);
 682         printf("%s0x%08lx: ", prefix, (unsigned long) obj);
 683         if (cur_depth < brief_depth) {
 684             fputs(lowtag_Names[type], stdout);
 685             (*verbose_fns[type])(obj);
 686         }
 687         else
 688             (*brief_fns[type])(obj);
 689     }
 690     else {
 691         if (dont_descend)
 692             printf("$%s", var_name(var));
 693         else {
 694             if (var != NULL)
 695                 printf("$%s=", var_name(var));
 696             (*brief_fns[type])(obj);
 697         }
 698     }
 699     cur_depth--;
 700     dont_descend = 0;
 701 }
 702
 703 void reset_printer()
 704 {
 705     cur_clock++;
 706     cur_lines = 0;
 707     dont_descend = 0;
 708 }
 709
 710 void print(lispobj obj)
 711 {
 712     skip_newline = 1;
 713     cur_depth = 0;
 714     max_depth = 5;
 715     max_lines = 20;
 716
 717     print_obj("", obj);
 718
 719     putchar('\n');
 720 }
 721
 722 void brief_print(lispobj obj)
 723 {
 724     skip_newline = 1;
 725     cur_depth = 0;
 726     max_depth = 1;
 727     max_lines = 5000;
 728
 729     print_obj("", obj);
 730     putchar('\n');
 731 }