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