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 CELL look_for;
 312
 313 void find_code_references_step(F_COMPILED *compiled, CELL code_start, CELL literals_start)
 314 {
 315         CELL scan;
 316         CELL literal_end = literals_start + compiled->literals_length;
 317
 318         for(scan = literals_start; scan < literal_end; scan += CELLS)
 319         {
 320                 CELL code_start = (CELL)(compiled + 1);
 321                 CELL literal_start = code_start + compiled->code_length;
 322
 323                 CELL obj = get(literal_start);
 324
 325                 if(look_for == get(scan))
 326                 {
 327                         print_cell_hex_pad(obj);
 328                         print_string(" ");
 329                         print_nested_obj(obj,2);
 330                         nl();
 331                 }
 332         }
 333 }
 334
 335 void find_code_references(CELL look_for_)
 336 {
 337         look_for = look_for_;
 338         iterate_code_heap(find_code_references_step);
 339 }
 340
 341 void factorbug(void)
 342 {
 343         if(fep_disabled)
 344         {
 345                 print_string("Low level debugger disabled\n");
 346                 exit(1);
 347         }
 348
 349         /* open_console(); */
 350
 351         print_string("Starting low level debugger...\n");
 352         print_string("  Basic commands:\n");
 353         print_string("q                -- continue executing Factor - NOT SAFE\n");
 354         print_string("im               -- save image to fep.image\n");
 355         print_string("x                -- exit Factor\n");
 356         print_string("  Advanced commands:\n");
 357         print_string("d <addr> <count> -- dump memory\n");
 358         print_string("u <addr>         -- dump object at tagged <addr>\n");
 359         print_string(". <addr>         -- print object at tagged <addr>\n");
 360         print_string("t                -- toggle output trimming\n");
 361         print_string("s r              -- dump data, retain stacks\n");
 362         print_string(".s .r .c         -- print data, retain, call stacks\n");
 363         print_string("e                -- dump environment\n");
 364         print_string("g                -- dump generations\n");
 365         print_string("card <addr>      -- print card containing address\n");
 366         print_string("addr <card>      -- print address containing card\n");
 367         print_string("data             -- data heap dump\n");
 368         print_string("words            -- words dump\n");
 369         print_string("tuples           -- tuples dump\n");
 370         print_string("refs <addr>      -- find data heap references to object\n");
 371         print_string("push <addr>      -- push object on data stack - NOT SAFE\n");
 372         print_string("code             -- code heap dump\n");
 373
 374         bool seen_command = false;
 375
 376         for(;;)
 377         {
 378                 char cmd[1024];
 379
 380                 print_string("READY\n");
 381                 fflush(stdout);
 382
 383                 if(scanf("%1000s",cmd) <= 0)
 384                 {
 385                         if(!seen_command)
 386                         {
 387                                 /* If we exit with an EOF immediately, then
 388                                 dump stacks. This is useful for builder and
 389                                 other cases where Factor is run with stdin
 390                                 redirected to /dev/null */
 391                                 fep_disabled = true;
 392
 393                                 print_datastack();
 394                                 print_retainstack();
 395                                 print_callstack();
 396                         }
 397
 398                         exit(1);
 399                 }
 400
 401                 seen_command = true;
 402
 403                 if(strcmp(cmd,"d") == 0)
 404                 {
 405                         CELL addr = read_cell_hex();
 406                         scanf(" ");
 407                         CELL count = read_cell_hex();
 408                         dump_memory(addr,addr+count);
 409                 }
 410                 else if(strcmp(cmd,"u") == 0)
 411                 {
 412                         CELL addr = read_cell_hex();
 413                         CELL count = object_size(addr);
 414                         dump_memory(addr,addr+count);
 415                 }
 416                 else if(strcmp(cmd,".") == 0)
 417                 {
 418                         CELL addr = read_cell_hex();
 419                         print_obj(addr);
 420                         print_string("\n");
 421                 }
 422                 else if(strcmp(cmd,"t") == 0)
 423                         full_output = !full_output;
 424                 else if(strcmp(cmd,"s") == 0)
 425                         dump_memory(ds_bot,ds);
 426                 else if(strcmp(cmd,"r") == 0)
 427                         dump_memory(rs_bot,rs);
 428                 else if(strcmp(cmd,".s") == 0)
 429                         print_datastack();
 430                 else if(strcmp(cmd,".r") == 0)
 431                         print_retainstack();
 432                 else if(strcmp(cmd,".c") == 0)
 433                         print_callstack();
 434                 else if(strcmp(cmd,"e") == 0)
 435                 {
 436                         int i;
 437                         for(i = 0; i < USER_ENV; i++)
 438                                 dump_cell((CELL)&userenv[i]);
 439                 }
 440                 else if(strcmp(cmd,"g") == 0)
 441                         dump_generations();
 442                 else if(strcmp(cmd,"card") == 0)
 443                 {
 444                         CELL addr = read_cell_hex();
 445                         print_cell_hex((CELL)ADDR_TO_CARD(addr));
 446                         nl();
 447                 }
 448                 else if(strcmp(cmd,"addr") == 0)
 449                 {
 450                         CELL card = read_cell_hex();
 451                         print_cell_hex((CELL)CARD_TO_ADDR(card));
 452                         nl();
 453                 }
 454                 else if(strcmp(cmd,"q") == 0)
 455                         return;
 456                 else if(strcmp(cmd,"x") == 0)
 457                         exit(1);
 458                 else if(strcmp(cmd,"im") == 0)
 459                         save_image(STRING_LITERAL("fep.image"));
 460                 else if(strcmp(cmd,"data") == 0)
 461                         dump_objects(-1);
 462                 else if(strcmp(cmd,"refs") == 0)
 463                 {
 464                         CELL addr = read_cell_hex();
 465                         print_string("Data heap references:\n");
 466                         find_data_references(addr);
 467                         print_string("Code heap references:\n");
 468                         find_code_references(addr);
 469                         nl();
 470                 }
 471                 else if(strcmp(cmd,"words") == 0)
 472                         dump_objects(WORD_TYPE);
 473                 else if(strcmp(cmd,"tuples") == 0)
 474                         dump_objects(TUPLE_TYPE);
 475                 else if(strcmp(cmd,"push") == 0)
 476                 {
 477                         CELL addr = read_cell_hex();
 478                         dpush(addr);
 479                 }
 480                 else if(strcmp(cmd,"code") == 0)
 481                         dump_heap(&code_heap);
 482                 else
 483                         print_string("unknown command\n");
 484         }
 485 }
 486
 487 void primitive_die(void)
 488 {
 489         print_string("The die word was called by the library. Unless you called it yourself,\n");
 490         print_string("you have triggered a bug in Factor. Please report.\n");
 491         factorbug();
 492 }