More Valgrind support. New option --vg-debug which turns on

Valgrind protection of free blocks. This works independently
of --gc-debug.

4 files changed, 78 insertions, 11 deletions

diff --git a/ChangeLog b/ChangeLog
index 137aa61a..18dbddfd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,30 @@
 2009-11-25  Kaz Kylheku  <kkylheku@gmail.com>
 
+	More Valgrind support. New option --vg-debug which turns on
+	Valgrind protection of free blocks. This works independently
+	of --gc-debug.
+
+	* gc.c (opt_vg_debug): New conditionally defined global variable.
+	(more): Mark entire heap of free blocks inaccessible, if
+	vg debugging is enabled.
+	(make_obj): If vg debugging enabled, mark returned block as accessible,
+	but undefined, and take care to grant self temporary access while
+	manipulating the free list.
+	(finalize): Removed old debugging logic of not freeing strings
+	and vectors during gc debug. If the null pointers are ever a problem
+	during debugging, they can be checked inside obj_print, and
+	turned into #<garbage ...> notation.
+	(sweep): Switch to FIFO free block recycling if vg debugging is
+	enabled, just like when gc debugging is enabled.
+	Mark freed blocks as inaccessible, careful to grant self
+	temporary access while manipulating the free list.
+
+	* txr.c (txr_main): Parse the --vg-debug option.
+
+	* txr.h (opt_vg_debug): Conditionally declared.
+
+2009-11-25  Kaz Kylheku  <kkylheku@gmail.com>
+
 	Fix a build breakage that may happen on some platforms.
 	The parser.y file includes "utf8.h", which uses the the type wint_t.
 	It also includes "lib.h" which uses "wchar_t". But it fails
diff --git a/gc.c b/gc.c
index 277b2adf..a8919390 100644
--- a/gc.c
+++ b/gc.c
@@ -52,6 +52,9 @@ typedef struct heap {
 } heap_t;
 
 int opt_gc_debug;
+#ifdef HAVE_VALGRIND
+int opt_vg_debug;
+#endif
 static val *gc_stack_bottom;
 
 static val *prot_stack[PROT_STACK_SIZE];
@@ -122,6 +125,11 @@ static void more()
 
   heap->next = heap_list;
   heap_list = heap;
+
+#ifdef HAVE_VALGRIND
+  if (opt_vg_debug)
+    VALGRIND_MAKE_MEM_NOACCESS(&heap->block, sizeof heap->block);
+#endif
 }
 
 val make_obj(void)
@@ -134,7 +142,15 @@ val make_obj(void)
   for (tries = 0; tries < 3; tries++) {
     if (free_list) {
       val ret = free_list;
+#ifdef HAVE_VALGRIND
+      if (opt_vg_debug)
+        VALGRIND_MAKE_MEM_DEFINED(free_list, sizeof *free_list);
+#endif
       free_list = free_list->t.next;
+#ifdef HAVE_VALGRIND
+      if (opt_vg_debug)
+        VALGRIND_MAKE_MEM_UNDEFINED(ret, sizeof *ret);
+#endif
       return ret;
     }
 
@@ -155,10 +171,8 @@ static void finalize(val obj)
   case CONS:
     return;
   case STR:
-    if (!opt_gc_debug) {
-      free(obj->st.str);
-      obj->st.str = 0;
-    }
+    free(obj->st.str);
+    obj->st.str = 0;
     return;
   case CHR:
   case NUM:
@@ -168,10 +182,8 @@ static void finalize(val obj)
   case FUN:
     return;
   case VEC:
-    if (!opt_gc_debug) {
-      free(obj->v.vec-2);
-      obj->v.vec = 0;
-    }
+    free(obj->v.vec-2);
+    obj->v.vec = 0;
     return;
   case LCONS:
   case LSTR:
@@ -314,7 +326,12 @@ static void mark(void)
 static void sweep(void)
 {
   heap_t *heap;
-  int dbg = opt_gc_debug;
+  int gc_dbg = opt_gc_debug;
+#ifdef HAVE_VALGRIND
+  int vg_dbg = opt_vg_debug;
+#else
+  int vg_dbg = 0;
+#endif
 
   for (heap = heap_list; heap != 0; heap = heap->next) {
     obj_t *block, *end;
@@ -333,7 +350,7 @@ static void sweep(void)
       if (block->t.type & FREE)
         continue;
 
-      if (0 && dbg) {
+      if (0 && gc_dbg) {
         format(std_error, lit("~a: finalizing: "), progname, nao);
         obj_print(block, std_error);
         put_char(std_error, chr('\n'));
@@ -347,9 +364,20 @@ static void sweep(void)
          rather than LIFO, which increases our chances that the
          code which is still using the object will trip on
          the freed object before it is recycled. */
-      if (dbg) {
+      if (gc_dbg || vg_dbg) {
+#ifdef HAVE_VALGRIND
+        if (vg_dbg && free_tail != &free_list)
+          VALGRIND_MAKE_MEM_DEFINED(free_tail, sizeof *free_tail);
+#endif
         *free_tail = block;
         block->t.next = nil;
+#ifdef HAVE_VALGRIND
+        if (vg_dbg) {
+          if (free_tail != &free_list)
+            VALGRIND_MAKE_MEM_NOACCESS(free_tail, sizeof *free_tail);
+          VALGRIND_MAKE_MEM_NOACCESS(block, sizeof *block);
+        }
+#endif
         free_tail = &block->t.next;
       } else {
         block->t.next = free_list;
diff --git a/txr.c b/txr.c
index f73ed961..8f87571e 100644
--- a/txr.c
+++ b/txr.c
@@ -270,6 +270,17 @@ static int txr_main(int argc, char **argv)
       opt_gc_debug = 1;
       argv++, argc--;
       continue;
+    } else if (!strcmp(*argv, "--vg-debug")) {
+#ifdef HAVE_VALGRIND
+      opt_vg_debug = 1;
+      argv++, argc--;
+      continue;
+#else
+      format(std_error,
+             lit("~a: option ~a requires Valgrind support compiled in\n"),
+             prog_string, string_utf8(*argv), nao);
+      return EXIT_FAILURE;
+#endif
     }
 
     {
diff --git a/txr.h b/txr.h
index d230cd28..36f29715 100644
--- a/txr.h
+++ b/txr.h
@@ -28,6 +28,9 @@ extern int opt_loglevel;
 extern int opt_nobindings;
 extern int opt_arraydims;
 extern int opt_gc_debug;
+#ifdef HAVE_VALGRIND
+extern int opt_vg_debug;
+#endif
 extern const wchar_t *version;
 extern const wchar_t *progname;
 extern int output_produced;