vm/debug.c

   1 #include "master.h"
   2
   3 static bool full_output;
   4
   5 void print_chars(F_STRING* str)
   6 {
   7         CELL i;
   8         for(i = 0; i < string_capacity(str); i++)
   9                 putchar(string_nth(str,i));
  10 }
  11
  12 void print_word(F_WORD* word, CELL nesting)
  13 {
  14
  15         if(type_of(word->vocabulary) == STRING_TYPE)
  16         {
  17                 print_chars(untag_string(word->vocabulary));
  18                 print_string(":");
  19         }
  20
  21         if(type_of(word->name) == STRING_TYPE)
  22                 print_chars(untag_string(word->name));
  23         else
  24         {
  25                 print_string("#<not a string: ");
  26                 print_nested_obj(word->name,nesting);
  27                 print_string(">");
  28         }
  29 }
  30
  31 void print_factor_string(F_STRING* str)
  32 {
  33         putchar('"');
  34         print_chars(str);
  35         putchar('"');
  36 }
  37
  38 void print_array(F_ARRAY* array, CELL nesting)
  39 {
  40         CELL length = array_capacity(array);
  41         CELL i;
  42         bool trimmed;
  43
  44         if(length > 10 && !full_output)
  45         {
  46                 trimmed = true;
  47                 length = 10;
  48         }
  49         else
  50                 trimmed = false;
  51
  52         for(i = 0; i < length; i++)
  53         {
  54                 print_string(" ");
  55                 print_nested_obj(array_nth(array,i),nesting);
  56         }
  57
  58         if(trimmed)
  59                 print_string("...");
  60 }
  61
  62 void print_tuple(F_TUPLE* tuple, CELL nesting)
  63 {
  64         F_TUPLE_LAYOUT *layout = untag_object(tuple->layout);
  65         CELL length = to_fixnum(layout->size);
  66
  67         print_string(" ");
  68         print_nested_obj(layout->class,nesting);
  69
  70         CELL i;
  71         bool trimmed;
  72
  73         if(length > 10 && !full_output)
  74         {
  75                 trimmed = true;
  76                 length = 10;
  77         }
  78         else
  79                 trimmed = false;
  80
  81         for(i = 0; i < length; i++)
  82         {
  83                 print_string(" ");
  84                 print_nested_obj(tuple_nth(tuple,i),nesting);
  85         }
  86
  87         if(trimmed)
  88                 print_string("...");
  89 }
  90
  91 void print_nested_obj(CELL obj, F_FIXNUM nesting)
  92 {
  93         if(nesting <= 0 && !full_output)
  94         {
  95                 print_string(" ... ");
  96                 return;
  97         }
  98
  99         F_QUOTATION *quot;
 100
 101         switch(type_of(obj))
 102         {
 103         case FIXNUM_TYPE:
 104                 print_fixnum(untag_fixnum_fast(obj));
 105                 break;
 106         case WORD_TYPE:
 107                 print_word(untag_word(obj),nesting - 1);
 108                 break;
 109         case STRING_TYPE:
 110                 print_factor_string(untag_string(obj));
 111                 break;
 112         case F_TYPE:
 113                 print_string("f");
 114                 break;
 115         case TUPLE_TYPE:
 116                 print_string("T{");
 117                 print_tuple(untag_object(obj),nesting - 1);
 118                 print_string(" }");
 119                 break;
 120         case ARRAY_TYPE:
 121                 print_string("{");
 122                 print_array(untag_object(obj),nesting - 1);
 123                 print_string(" }");
 124                 break;
 125         case QUOTATION_TYPE:
 126                 print_string("[");
 127                 quot = untag_object(obj);
 128                 print_array(untag_object(quot->array),nesting - 1);
 129                 print_string(" ]");
 130                 break;
 131         default:
 132                 print_string("#<type "); print_cell(type_of(obj)); print_string(" @ "); print_cell_hex(obj); print_string(">");
 133                 break;
 134         }
 135 }
 136
 137 void print_obj(CELL obj)
 138 {
 139         print_nested_obj(obj,10);
 140 }
 141
 142 void print_objects(CELL start, CELL end)
 143 {
 144         for(; start <= end; start += CELLS)
 145         {
 146                 print_obj(get(start));
 147                 nl();
 148         }
 149 }
 150
 151 void print_datastack(void)
 152 {
 153         print_string("==== DATA STACK:\n");
 154         print_objects(ds_bot,ds);
 155 }
 156
 157 void print_retainstack(void)
 158 {
 159         print_string("==== RETAIN STACK:\n");
 160         print_objects(rs_bot,rs);
 161 }
 162
 163 void print_stack_frame(F_STACK_FRAME *frame)
 164 {
 165         print_obj(frame_executing(frame));
 166         print_string("\n");
 167         print_obj(frame_scan(frame));
 168         print_string("\n");
 169         print_cell_hex((CELL)frame_executing(frame));
 170         print_string(" ");
 171         print_cell_hex((CELL)frame->xt);
 172         print_string("\n");
 173 }
 174
 175 void print_callstack(void)
 176 {
 177         print_string("==== CALL STACK:\n");
 178         CELL bottom = (CELL)stack_chain->callstack_bottom;
 179         CELL top = (CELL)stack_chain->callstack_top;
 180         iterate_callstack(top,bottom,print_stack_frame);
 181 }
 182
 183 void dump_cell(CELL cell)
 184 {
 185         print_cell_hex_pad(cell); print_string(": ");
 186
 187         cell = get(cell);
 188
 189         print_cell_hex_pad(cell); print_string(" tag "); print_cell(TAG(cell));
 190
 191         switch(TAG(cell))
 192         {
 193         case OBJECT_TYPE:
 194         case BIGNUM_TYPE:
 195         case FLOAT_TYPE:
 196                 if(cell == F)
 197                         print_string(" -- F");
 198                 else if(cell < TYPE_COUNT<<TAG_BITS)
 199                 {
 200                         print_string(" -- possible header: ");
 201                         print_cell(cell>>TAG_BITS);
 202                 }
 203                 else if(cell >= data_heap->segment->start
 204                         && cell < data_heap->segment->end)
 205                 {
 206                         CELL header = get(UNTAG(cell));
 207                         CELL type = header>>TAG_BITS;
 208                         print_string(" -- object; ");
 209                         if(TAG(header) == 0 && type < TYPE_COUNT)
 210                         {
 211                                 print_string(" type "); print_cell(type);
 212                         }
 213                         else
 214                                 print_string(" header corrupt");
 215                 }
 216                 break;
 217         }
 218
 219         nl();
 220 }
 221
 222 void dump_memory(CELL from, CELL to)
 223 {
 224         from = UNTAG(from);
 225
 226         for(; from <= to; from += CELLS)
 227                 dump_cell(from);
 228 }
 229
 230 void dump_zone(F_ZONE *z)
 231 {
 232         print_string("Start="); print_cell(z->start);
 233         print_string(", size="); print_cell(z->size);
 234         print_string(", here="); print_cell(z->here - z->start); nl();
 235 }
 236
 237 void dump_generations(void)
 238 {
 239         CELL i;
 240
 241         print_string("Nursery: ");
 242         dump_zone(&nursery);
 243
 244         for(i = 1; i < data_heap->gen_count; i++)
 245         {
 246                 print_string("Generation "); print_cell(i); print_string(": ");
 247                 dump_zone(&data_heap->generations[i]);
 248         }
 249
 250         for(i = 0; i < data_heap->gen_count; i++)
 251         {
 252                 print_string("Semispace "); print_cell(i); print_string(": ");
 253                 dump_zone(&data_heap->semispaces[i]);
 254         }
 255
 256         print_string("Cards: base=");
 257         print_cell((CELL)data_heap->cards);
 258         print_string(", size=");
 259         print_cell((CELL)(data_heap->cards_end - data_heap->cards));
 260         nl();
 261 }
 262
 263 void dump_objects(F_FIXNUM type)
 264 {
 265         gc();
 266         begin_scan();
 267
 268         CELL obj;
 269         while((obj = next_object()) != F)
 270         {
 271                 if(type == -1 || type_of(obj) == type)
 272                 {
 273                         print_cell_hex_pad(obj);
 274                         print_string(" ");
 275                         print_nested_obj(obj,2);
 276                         nl();
 277                 }
 278         }
 279
 280         /* end scan */
 281         gc_off = false;
 282 }
 283
 284 CELL look_for;
 285 CELL obj;
 286
 287 void find_data_references_step(CELL *scan)
 288 {
 289         if(look_for == *scan)
 290         {
 291                 print_cell_hex_pad(obj);
 292                 print_string(" ");
 293                 print_nested_obj(obj,2);
 294                 nl();
 295         }
 296 }
 297
 298 void find_data_references(CELL look_for_)
 299 {
 300         look_for = look_for_;
 301
 302         begin_scan();
 303
 304         while((obj = next_object()) != F)
 305                 do_slots(UNTAG(obj),find_data_references_step);
 306
 307         /* end scan */
 308         gc_off = false;
 309 }
 310
 311 /* Dump all code blocks for debugging */
 312 void dump_code_heap(void)
 313 {
 314         CELL size = 0;
 315
 316         F_BLOCK *scan = first_block(&code_heap);
 317
 318         while(scan)
 319         {
 320                 char *status;
 321                 switch(scan->status)
 322                 {
 323                 case B_FREE:
 324                         status = "free";
 325                         break;
 326                 case B_ALLOCATED:
 327                         size += object_size(block_to_compiled(scan)->relocation);
 328                         status = "allocated";
 329                         break;
 330                 case B_MARKED:
 331                         size += object_size(block_to_compiled(scan)->relocation);
 332                         status = "marked";
 333                         break;
 334                 default:
 335                         status = "invalid";
 336                         break;
 337                 }
 338
 339                 print_cell_hex((CELL)scan); print_string(" ");
 340                 print_cell_hex(scan->size); print_string(" ");
 341                 print_string(status); print_string("\n");
 342
 343                 scan = next_block(&code_heap,scan);
 344         }
 345
 346         print_cell(size); print_string(" bytes of relocation data\n");
 347 }
 348
 349 void factorbug(void)
 350 {
 351         if(fep_disabled)
 352         {
 353                 print_string("Low level debugger disabled\n");
 354                 exit(1);
 355         }
 356
 357         /* open_console(); */
 358
 359         print_string("Starting low level debugger...\n");
 360         print_string("  Basic commands:\n");
 361         print_string("q                -- continue executing Factor - NOT SAFE\n");
 362         print_string("im               -- save image to fep.image\n");
 363         print_string("x                -- exit Factor\n");
 364         print_string("  Advanced commands:\n");
 365         print_string("d <addr> <count> -- dump memory\n");
 366         print_string("u <addr>         -- dump object at tagged <addr>\n");
 367         print_string(". <addr>         -- print object at tagged <addr>\n");
 368         print_string("t                -- toggle output trimming\n");
 369         print_string("s r              -- dump data, retain stacks\n");
 370         print_string(".s .r .c         -- print data, retain, call stacks\n");
 371         print_string("e                -- dump environment\n");
 372         print_string("g                -- dump generations\n");
 373         print_string("card <addr>      -- print card containing address\n");
 374         print_string("addr <card>      -- print address containing card\n");
 375         print_string("data             -- data heap dump\n");
 376         print_string("words            -- words dump\n");
 377         print_string("tuples           -- tuples dump\n");
 378         print_string("refs <addr>      -- find data heap references to object\n");
 379         print_string("push <addr>      -- push object on data stack - NOT SAFE\n");
 380         print_string("code             -- code heap dump\n");
 381
 382         bool seen_command = false;
 383
 384         for(;;)
 385         {
 386                 char cmd[1024];
 387
 388                 print_string("READY\n");
 389                 fflush(stdout);
 390
 391                 if(scanf("%1000s",cmd) <= 0)
 392                 {
 393                         if(!seen_command)
 394                         {
 395                                 /* If we exit with an EOF immediately, then
 396                                 dump stacks. This is useful for builder and
 397                                 other cases where Factor is run with stdin
 398                                 redirected to /dev/null */
 399                                 fep_disabled = true;
 400
 401                                 print_datastack();
 402                                 print_retainstack();
 403                                 print_callstack();
 404                         }
 405
 406                         exit(1);
 407                 }
 408
 409                 seen_command = true;
 410
 411                 if(strcmp(cmd,"d") == 0)
 412                 {
 413                         CELL addr = read_cell_hex();
 414                         scanf(" ");
 415                         CELL count = read_cell_hex();
 416                         dump_memory(addr,addr+count);
 417                 }
 418                 else if(strcmp(cmd,"u") == 0)
 419                 {
 420                         CELL addr = read_cell_hex();
 421                         CELL count = object_size(addr);
 422                         dump_memory(addr,addr+count);
 423                 }
 424                 else if(strcmp(cmd,".") == 0)
 425                 {
 426                         CELL addr = read_cell_hex();
 427                         print_obj(addr);
 428                         print_string("\n");
 429                 }
 430                 else if(strcmp(cmd,"t") == 0)
 431                         full_output = !full_output;
 432                 else if(strcmp(cmd,"s") == 0)
 433                         dump_memory(ds_bot,ds);
 434                 else if(strcmp(cmd,"r") == 0)
 435                         dump_memory(rs_bot,rs);
 436                 else if(strcmp(cmd,".s") == 0)
 437                         print_datastack();
 438                 else if(strcmp(cmd,".r") == 0)
 439                         print_retainstack();
 440                 else if(strcmp(cmd,".c") == 0)
 441                         print_callstack();
 442                 else if(strcmp(cmd,"e") == 0)
 443                 {
 444                         int i;
 445                         for(i = 0; i < USER_ENV; i++)
 446                                 dump_cell((CELL)&userenv[i]);
 447                 }
 448                 else if(strcmp(cmd,"g") == 0)
 449                         dump_generations();
 450                 else if(strcmp(cmd,"card") == 0)
 451                 {
 452                         CELL addr = read_cell_hex();
 453                         print_cell_hex((CELL)ADDR_TO_CARD(addr));
 454                         nl();
 455                 }
 456                 else if(strcmp(cmd,"addr") == 0)
 457                 {
 458                         CELL card = read_cell_hex();
 459                         print_cell_hex((CELL)CARD_TO_ADDR(card));
 460                         nl();
 461                 }
 462                 else if(strcmp(cmd,"q") == 0)
 463                         return;
 464                 else if(strcmp(cmd,"x") == 0)
 465                         exit(1);
 466                 else if(strcmp(cmd,"im") == 0)
 467                         save_image(STRING_LITERAL("fep.image"));
 468                 else if(strcmp(cmd,"data") == 0)
 469                         dump_objects(-1);
 470                 else if(strcmp(cmd,"refs") == 0)
 471                 {
 472                         CELL addr = read_cell_hex();
 473                         print_string("Data heap references:\n");
 474                         find_data_references(addr);
 475                         nl();
 476                 }
 477                 else if(strcmp(cmd,"words") == 0)
 478                         dump_objects(WORD_TYPE);
 479                 else if(strcmp(cmd,"tuples") == 0)
 480                         dump_objects(TUPLE_TYPE);
 481                 else if(strcmp(cmd,"push") == 0)
 482                 {
 483                         CELL addr = read_cell_hex();
 484                         dpush(addr);
 485                 }
 486                 else if(strcmp(cmd,"code") == 0)
 487                         dump_code_heap();
 488                 else
 489                         print_string("unknown command\n");
 490         }
 491 }
 492
 493 void primitive_die(void)
 494 {
 495         print_string("The die word was called by the library. Unless you called it yourself,\n");
 496         print_string("you have triggered a bug in Factor. Please report.\n");
 497         factorbug();
 498 }