From 6b40ed63f4b89135ae9ecb8ea3e664d528d2bcec Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 25 Apr 2014 16:47:06 -0700 Subject: [PATCH] Call verify_heap before GC to scan for bogosities. Trap recovery (on Unix) occasionally fails the assert in linkage_section_type when its scan of the heap encounters non-marked words that are not "hidden" by a non-marked vector header. The new verify_heap function scans the heap in the same way, and complains on stderr about any invalid linkage section types, object types, etc. If the GC_Debug flag is set, verify_heap is called by the garbage-collect primitive to scan maximal heap. The new dump_heap_at function can be used to inspect the heap around a reported bogosity. --- src/microcode/debug.c | 231 +++++++++++++++++++++++++++++++++++++++++ src/microcode/extern.h | 1 + src/microcode/memmag.c | 4 + 3 files changed, 236 insertions(+) diff --git a/src/microcode/debug.c b/src/microcode/debug.c index fa2fc681e..c5336cb97 100644 --- a/src/microcode/debug.c +++ b/src/microcode/debug.c @@ -734,6 +734,237 @@ Print_Primitive (SCHEME_OBJECT primitive) } } +#ifdef ENABLE_DEBUGGING_TOOLS + +static void +dump_word (SCHEME_OBJECT *addr) +{ + int i = 0; + unsigned char * bytes = (unsigned char *)addr; + outf_error ("%#lx: ", (unsigned long)addr); + while (i < sizeof(SCHEME_OBJECT)) + { + if (isgraph (bytes[i])) + outf_error (" %2c", bytes[i]); + else + outf_error (" %02x", bytes[i]); + i += 1; + } + outf_error ("\n"); +} + +static SCHEME_OBJECT * +next_addr (SCHEME_OBJECT * addr) +{ + SCHEME_OBJECT object = *addr; + unsigned int type = OBJECT_TYPE (object); + switch (type) + { + case TC_LINKAGE_SECTION: + { + linkage_section_type_t section_type + = ((linkage_section_type_t)((OBJECT_DATUM (object)) >> 16)); + switch (section_type) + { + case LINKAGE_SECTION_TYPE_GLOBAL_OPERATOR: + case LINKAGE_SECTION_TYPE_OPERATOR: + { + unsigned long n_words = ((OBJECT_DATUM (object)) & 0xFFFFUL); + return (addr + (1 + n_words)); + } + case LINKAGE_SECTION_TYPE_REFERENCE: + case LINKAGE_SECTION_TYPE_ASSIGNMENT: + return (addr + 1); + default: + outf_error ("Invalid linkage section type: %d\n", section_type); + return (addr + 1); + } + } + case TC_MANIFEST_CLOSURE: + return (compiled_closure_objects (addr + 1)); + case TC_MANIFEST_NM_VECTOR: + { + unsigned long n_words = (OBJECT_DATUM (object)); + return (addr + (1 + n_words)); + } + default: + return (addr + 1); + } +} + +static void +dump_object (SCHEME_OBJECT * addr) +{ + SCHEME_OBJECT object = *addr; + outf_error ("%#lx: ", (unsigned long)addr); + print_object (object); + { + SCHEME_OBJECT * end = next_addr (addr); + while (++addr < end) + dump_word (addr); + } +} + +#define SAVE_COUNT 16 +static SCHEME_OBJECT *saved_addrs[SAVE_COUNT]; +static int saved_index; + +static void +dump_heap_area_at (SCHEME_OBJECT * addr, + SCHEME_OBJECT * area, SCHEME_OBJECT * end) +{ + SCHEME_OBJECT * scan = area; + assert (area <= addr && addr < end); + saved_index = 0; + while (scan < addr) + { + saved_addrs[saved_index++] = scan; + if (saved_index == SAVE_COUNT) saved_index = 0; + scan = next_addr (scan); + } + { + int i = saved_index; + do + { + SCHEME_OBJECT * saved = saved_addrs[i++]; + if (i == SAVE_COUNT) i = 0; + dump_object (saved); + } + while (i != saved_index); + } + outf_error ("=> "); + { + int i = 0; + while (i < SAVE_COUNT && scan < end) + { + dump_object (scan); + i += 1; + scan = next_addr (scan); + } + } +} + +void +dump_heap_at (SCHEME_OBJECT *addr) +{ + if (constant_start <= addr && addr < constant_alloc_next) + { + outf_error ("Scanning constant area (%#lx - %#lx):\n", + (unsigned long)constant_start, + (unsigned long)constant_alloc_next); + dump_heap_area_at (addr, constant_start, constant_alloc_next); + } + else if (heap_start <= addr && addr < Free) + { + outf_error ("Scanning heap area (%#lx - %#lx):\n", + (unsigned long)heap_start, + (unsigned long)Free); + dump_heap_area_at (addr, heap_start, Free); + } + else + { + outf_error ("%#lx: not a heap address\n", (unsigned long)addr); + } + outf_flush_error (); +} + +static bool +verify_heap_area (const char * name, SCHEME_OBJECT * area, SCHEME_OBJECT * end) +{ + int complaints = 0; + + while (area < end) + { + SCHEME_OBJECT object = *area; + unsigned int type = OBJECT_TYPE (object); + switch (type) + { + case TC_LINKAGE_SECTION: + { + linkage_section_type_t section_type + = ((linkage_section_type_t)((OBJECT_DATUM (object)) >> 16)); + switch (section_type) + { + case LINKAGE_SECTION_TYPE_GLOBAL_OPERATOR: + case LINKAGE_SECTION_TYPE_OPERATOR: + { + unsigned long n_words = ((OBJECT_DATUM (object)) & 0xFFFFUL); + SCHEME_OBJECT * next = area + (1 + n_words); + if (next > end) + { + outf_error ("; %#lx: Invalid linkage section size: %ld\n", + (unsigned long)area, n_words); + return (false); + } + area = next; + } + break; + case LINKAGE_SECTION_TYPE_REFERENCE: + case LINKAGE_SECTION_TYPE_ASSIGNMENT: + area += 1; + break; + default: + outf_error ("; %#lx: Invalid linkage section type: %d\n", + (unsigned long)area, section_type); + complaints += 1; + area += 1; + break; + } + } + break; + case TC_MANIFEST_CLOSURE: + area = compiled_closure_objects (area + 1); + break; + case TC_MANIFEST_NM_VECTOR: + { + unsigned long n_words = (OBJECT_DATUM (object)); + SCHEME_OBJECT * next = area + (1 + n_words); + if (next > end) + { + outf_error ("; %#lx: Invalid nm-vector size: %ld\n", + (unsigned long)area, n_words); + return (false); + } + area = next; + } + break; + default: + if (gc_type_code (type) == GC_UNDEFINED) + { + outf_error ("; %#lx: Invalid type code: %d (0x%x)\n", + (unsigned long)area, type, type); + complaints += 1; + } + area += 1; + break; + } + } + if (area != end) + { + outf_error ("; %#lx: Invalid address\n", (unsigned long)area); + return (false); + } + return (complaints == 0); +} + +bool +verify_heap (void) +{ + bool c = verify_heap_area ("constants", constant_start, constant_alloc_next); + bool h = verify_heap_area ("heap", heap_start, Free); + return (c && h); +} + +DEFINE_PRIMITIVE ("VERIFY-HEAP", Prim_verify_heap, 0, 0, + "Validate the heap.\n\ +Complains if a scan of the heap encounters anything unexpected.\n\ +Returns #T if the scan was successful and #F if there were any complaints.") +{ + PRIMITIVE_HEADER (0); + PRIMITIVE_RETURN (verify_heap () ? SHARP_T : SHARP_F); +} +#endif + /* Code for interactively setting and clearing the interpreter debugging flags. Invoked via the "D" command to the ^C handler or during each FASLOAD. */ diff --git a/src/microcode/extern.h b/src/microcode/extern.h index 92784051e..dacfea88a 100644 --- a/src/microcode/extern.h +++ b/src/microcode/extern.h @@ -112,6 +112,7 @@ extern void set_ulong_register (unsigned int, unsigned long); extern bool Per_File; extern bool Bignum_Debug; + extern bool verify_heap (void); extern void Pop_Return_Break_Point (void); extern unsigned int debug_slotno; extern unsigned int debug_nslots; diff --git a/src/microcode/memmag.c b/src/microcode/memmag.c index bad618985..72df8efbe 100644 --- a/src/microcode/memmag.c +++ b/src/microcode/memmag.c @@ -266,6 +266,10 @@ the primitive GC daemons before returning.") ENTER_CRITICAL_SECTION ("garbage collector"); +#ifdef ENABLE_DEBUGGING_TOOLS + if (GC_Debug == true) verify_heap (); +#endif + open_tospace (heap_start); initialize_weak_chain (); ephemeron_count = 0; -- 2.25.1