#include "master.h" void print_chars(F_STRING* str) { CELL i; for(i = 0; i < string_capacity(str); i++) putchar(string_nth(str,i)); } void print_word(F_WORD* word, CELL nesting) { if(type_of(word->vocabulary) == STRING_TYPE) { print_chars(untag_string(word->vocabulary)); printf(":"); } if(type_of(word->name) == STRING_TYPE) print_chars(untag_string(word->name)); else { printf("#name,nesting); printf(">"); } } void print_string(F_STRING* str) { putchar('"'); print_chars(str); putchar('"'); } void print_array(F_ARRAY* array, CELL nesting) { CELL length = array_capacity(array); CELL i; bool trimmed; if(length > 10) { trimmed = true; length = 10; } else trimmed = false; for(i = 0; i < length; i++) { printf(" "); print_nested_obj(array_nth(array,i),nesting); } if(trimmed) printf("..."); } void print_tuple(F_TUPLE* tuple, CELL nesting) { F_TUPLE_LAYOUT *layout = untag_object(tuple->layout); CELL length = to_fixnum(layout->size); printf(" "); print_nested_obj(layout->class,nesting); CELL i; bool trimmed; if(length > 10) { trimmed = true; length = 10; } else trimmed = false; for(i = 0; i < length; i++) { printf(" "); print_nested_obj(tuple_nth(tuple,i),nesting); } if(trimmed) printf("..."); } void print_nested_obj(CELL obj, F_FIXNUM nesting) { if(nesting <= 0) { printf(" ... "); return; } F_QUOTATION *quot; switch(type_of(obj)) { case FIXNUM_TYPE: printf("%ld",untag_fixnum_fast(obj)); break; case WORD_TYPE: print_word(untag_word(obj),nesting - 1); break; case STRING_TYPE: print_string(untag_string(obj)); break; case F_TYPE: printf("f"); break; case TUPLE_TYPE: printf("T{"); print_tuple(untag_object(obj),nesting - 1); printf(" }"); break; case ARRAY_TYPE: printf("{"); print_array(untag_object(obj),nesting - 1); printf(" }"); break; case QUOTATION_TYPE: printf("["); quot = untag_object(obj); print_array(untag_object(quot->array),nesting - 1); printf(" ]"); break; default: printf("#",type_of(obj),obj); break; } } void print_obj(CELL obj) { print_nested_obj(obj,10); } void print_objects(CELL start, CELL end) { for(; start <= end; start += CELLS) { print_obj(get(start)); printf("\n"); } } void print_datastack(void) { printf("==== DATA STACK:\n"); print_objects(ds_bot,ds); } void print_retainstack(void) { printf("==== RETAIN STACK:\n"); print_objects(rs_bot,rs); } void print_stack_frame(F_STACK_FRAME *frame) { print_obj(frame_executing(frame)); printf("\n"); print_obj(frame_scan(frame)); printf("\n"); printf("%lx\n",(CELL)frame_executing(frame)); printf("%lx\n",(CELL)frame->xt); } void print_callstack(void) { printf("==== CALL STACK:\n"); CELL bottom = (CELL)stack_chain->callstack_bottom; CELL top = (CELL)stack_chain->callstack_top; iterate_callstack(top,bottom,print_stack_frame); } void dump_cell(CELL cell) { printf("%08lx: ",cell); cell = get(cell); printf("%08lx tag %ld",cell,TAG(cell)); switch(TAG(cell)) { case OBJECT_TYPE: case BIGNUM_TYPE: case FLOAT_TYPE: if(cell == F) printf(" -- F"); else if(cell < TYPE_COUNT<>TAG_BITS); else if(cell >= data_heap->segment->start && cell < data_heap->segment->end) { CELL header = get(UNTAG(cell)); CELL type = header>>TAG_BITS; printf(" -- object; "); if(TAG(header) == 0 && type < TYPE_COUNT) printf(" type %ld",type); else printf(" header corrupt"); } break; } printf("\n"); } void dump_memory(CELL from, CELL to) { from = UNTAG(from); for(; from <= to; from += CELLS) dump_cell(from); } void dump_zone(F_ZONE *z) { printf("start=%ld, size=%ld, here=%ld\n", z->start,z->size,z->here - z->start); } void dump_generations(void) { int i; printf("Nursery: "); dump_zone(&nursery); for(i = 1; i < data_heap->gen_count; i++) { printf("Generation %d: ",i); dump_zone(&data_heap->generations[i]); } for(i = 0; i < data_heap->gen_count; i++) { printf("Semispace %d: ",i); dump_zone(&data_heap->semispaces[i]); } printf("Cards: base=%lx, size=%lx\n", (CELL)data_heap->cards, (CELL)(data_heap->cards_end - data_heap->cards)); } void dump_objects(F_FIXNUM type) { gc(); begin_scan(); CELL obj; while((obj = next_object()) != F) { if(type == -1 || type_of(obj) == type) { printf("%lx ",obj); print_nested_obj(obj,2); printf("\n"); } } /* end scan */ gc_off = false; } CELL look_for; CELL obj; void find_data_references_step(CELL *scan) { if(look_for == *scan) { printf("%lx ",obj); print_nested_obj(obj,2); printf("\n"); } } void find_data_references(CELL look_for_) { look_for = look_for_; begin_scan(); while((obj = next_object()) != F) do_slots(UNTAG(obj),find_data_references_step); /* end scan */ gc_off = false; } CELL look_for; void find_code_references_step(F_COMPILED *compiled, CELL code_start, CELL literals_start) { CELL scan; CELL literal_end = literals_start + compiled->literals_length; for(scan = literals_start; scan < literal_end; scan += CELLS) { CELL code_start = (CELL)(compiled + 1); CELL literal_start = code_start + compiled->code_length; CELL obj = get(literal_start); if(look_for == get(scan)) { printf("%lx ",obj); print_nested_obj(obj,2); printf("\n"); } } } void find_code_references(CELL look_for_) { look_for = look_for_; iterate_code_heap(find_code_references_step); } void factorbug(void) { reset_stdio(); open_console(); printf("Starting low level debugger...\n"); printf(" Basic commands:\n"); printf("q -- continue executing Factor - NOT SAFE\n"); printf("im -- save image to fep.image\n"); printf("x -- exit Factor\n"); printf(" Advanced commands:\n"); printf("d -- dump memory\n"); printf("u -- dump object at tagged \n"); printf(". -- print object at tagged \n"); printf("s r -- dump data, retain stacks\n"); printf(".s .r .c -- print data, retain, call stacks\n"); printf("e -- dump environment\n"); printf("g -- dump generations\n"); printf("card -- print card containing address\n"); printf("addr -- print address containing card\n"); printf("data -- data heap dump\n"); printf("words -- words dump\n"); printf("tuples -- tuples dump\n"); printf("refs -- find data heap references to object\n"); printf("push -- push object on data stack - NOT SAFE\n"); printf("code -- code heap dump\n"); bool seen_command = false; for(;;) { char cmd[1024]; printf("READY\n"); fflush(stdout); if(scanf("%1000s",cmd) <= 0) { if(!seen_command) { /* If we exit with an EOF immediately, then dump stacks. This is useful for builder and other cases where Factor is run with stdin redirected to /dev/null */ print_datastack(); print_retainstack(); print_callstack(); } exit(1); } seen_command = true; if(strcmp(cmd,"d") == 0) { CELL addr, count; scanf("%lx %lx",&addr,&count); dump_memory(addr,addr+count); } if(strcmp(cmd,"u") == 0) { CELL addr, count; scanf("%lx",&addr); count = object_size(addr); dump_memory(addr,addr+count); } else if(strcmp(cmd,".") == 0) { CELL addr; scanf("%lx",&addr); print_obj(addr); printf("\n"); } else if(strcmp(cmd,"s") == 0) dump_memory(ds_bot,ds); else if(strcmp(cmd,"r") == 0) dump_memory(rs_bot,rs); else if(strcmp(cmd,".s") == 0) print_datastack(); else if(strcmp(cmd,".r") == 0) print_retainstack(); else if(strcmp(cmd,".c") == 0) print_callstack(); else if(strcmp(cmd,"e") == 0) { int i; for(i = 0; i < USER_ENV; i++) dump_cell((CELL)&userenv[i]); } else if(strcmp(cmd,"g") == 0) dump_generations(); else if(strcmp(cmd,"card") == 0) { CELL addr; scanf("%lx",&addr); printf("%lx\n",(CELL)ADDR_TO_CARD(addr)); } else if(strcmp(cmd,"addr") == 0) { CELL card; scanf("%lx",&card); printf("%lx\n",(CELL)CARD_TO_ADDR(card)); } else if(strcmp(cmd,"q") == 0) return; else if(strcmp(cmd,"x") == 0) exit(1); else if(strcmp(cmd,"im") == 0) save_image(STR_FORMAT("fep.image")); else if(strcmp(cmd,"data") == 0) dump_objects(-1); else if(strcmp(cmd,"refs") == 0) { CELL addr; scanf("%lx",&addr); printf("Data heap references:\n"); find_data_references(addr); printf("Code heap references:\n"); find_code_references(addr); printf("\n"); } else if(strcmp(cmd,"words") == 0) dump_objects(WORD_TYPE); else if(strcmp(cmd,"tuples") == 0) dump_objects(TUPLE_TYPE); else if(strcmp(cmd,"push") == 0) { CELL addr; scanf("%lx",&addr); dpush(addr); } else if(strcmp(cmd,"code") == 0) dump_heap(&code_heap); else printf("unknown command\n"); } } DEFINE_PRIMITIVE(die) { fprintf(stderr,"The die word was called by the library. Unless you called it yourself,\n"); fprintf(stderr,"you have triggered a bug in Factor. Please report.\n"); factorbug(); }