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