[add support for annotating each allocation with its source line to help debug rts issues
John Meacham <john@repetae.net>**20100721090936
 Ignore-this: e38e6a7ba536a4bf8d79700ed1c67a2a
] addfile ./src/rts/debug.c
hunk ./Makefile.am 111
-	   src/rts/jhc_rts_alloc.c src/rts/jhc_rts.c src/rts/profile.c src/rts/jhc_rts2.c src/rts/bitarray.h \
+	   src/rts/debug.c src/rts/jhc_rts_alloc.c src/rts/jhc_rts.c src/rts/profile.c src/rts/jhc_rts2.c src/rts/bitarray.h \
hunk ./src/C/FromGrin2.hs 149
-    nh_stuff = text "static const void *nh_stuff[] = {" $$ fsep (punctuate (char ',') (cafnames ++ constnames ++ [text "NULL"]))  $$ text "};"
+    nh_stuff = text "static const void * const nh_stuff[] = {" $$ fsep (punctuate (char ',') (cafnames ++ constnames ++ [text "NULL"]))  $$ text "};"
hunk ./src/rts/debug.c 1
+#if JHC_VALGRIND
+#include <valgrind/valgrind.h>
+#include <valgrind/memcheck.h>
+#else
+#define VALGRIND_MAKE_MEM_UNDEFINED(x,y) \
+    do { } while (0)
+#define VALGRIND_MAKE_MEM_DEFINED(x,y) \
+    do { } while (0)
+#define VALGRIND_MAKE_MEM_NOACCESS(x,y) \
+    do { } while (0)
+#define VALGRIND_PRINTF(...) \
+    do { } while (0)
+#endif
+
+#if JHC_MEM_ANNOTATE && _JHC_GC == _JHC_GC_JGC
+#include <Judy.h>
+
+static Pvoid_t mem_annotate = NULL;
+
+#define XSTR(x) #x
+#define STR(x) XSTR(x)
+#define gc_alloc(gc,sc,c,nptrs) \
+    gc_alloc_annot(gc,sc,c,nptrs,(__FILE__ ":" STR(__LINE__)))
+
+
+A_UNUSED static void *
+gc_alloc_annot(gc_t gc,struct s_cache **sc, unsigned count, unsigned nptrs, char *str)
+{
+        void *ret = (gc_alloc)(gc,sc,count,nptrs);
+        PWord_t pval;
+        JLI(pval,mem_annotate,(Word_t)ret);
+        *pval = (Word_t)str;
+        return ret;
+}
+
+char *
+gc_lookup(void *ptr)
+{
+        PWord_t pval;
+        JLG(pval,mem_annotate,(Word_t)ptr & ~(Word_t)3);
+        return pval ? (char *)*pval : "(none)";
+}
+
+
+#endif
hunk ./src/rts/jhc_jgc.c 4
-#define TO_BLOCKS(x) ((x) <= GC_MINIMUM_SIZE*GC_BASE ? GC_MINIMUM_SIZE : (((x) - 1)/GC_BASE) + 1)
-
hunk ./src/rts/jhc_jgc.c 25
+static const void *nh_start, *nh_end;
hunk ./src/rts/jhc_jgc.c 27
-static void *nh_start, *nh_end;
+static bool
hunk ./src/rts/jhc_jgc.c 33
-
hunk ./src/rts/jhc_jgc.c 78
+        VALGRIND_MAKE_MEM_DEFINED(s,S_BLOCK(s)->pi.size * sizeof(uintptr_t));
hunk ./src/rts/jhc_jgc.c 98
-        memcpy(stack.stack + stack.ptr,root_stack.stack, root_stack.ptr * sizeof(root_stack.stack[0]));
-        stack.ptr += root_stack.ptr;
+        for(int i = 0; i < root_stack.ptr; i++) {
+                gc_add_grey(&stack, root_stack.stack[i]);
+                debugf(" %p", root_stack.stack[i]);
+        }
hunk ./src/rts/jhc_jgc.c 211
-gc_alloc(gc_t gc,struct s_cache **sc, unsigned count, unsigned nptrs)
+(gc_alloc)(gc_t gc,struct s_cache **sc, unsigned count, unsigned nptrs)
hunk ./src/rts/jhc_jgc.c 224
-static const void *nh_stuff[];
+static const void * const nh_stuff[];
hunk ./src/rts/jhc_jgc.h 3
-extern void _start, _end;
-
hunk ./src/rts/jhc_jgc.h 13
-#define GC_MINIMUM_SIZE 1
hunk ./src/rts/jhc_jgc.h 15
-#define TO_BLOCKS(x) ((x) <= GC_MINIMUM_SIZE*GC_BASE ? GC_MINIMUM_SIZE : (((x) - 1)/GC_BASE) + 1)
+#define TO_BLOCKS(x) ((x) <= GC_BASE ? 1 : (((x) - 1)/GC_BASE) + 1)
hunk ./src/rts/jhc_rts2.c 201
-                fptr_t dhead = FROM_SPTR(ds->head);
-                //assert((void *)dhead >= &_start && (void *)dhead < &_end);
hunk ./src/rts/jhc_rts_header.h 47
+#ifndef JHC_VALGRIND
+#define JHC_VALGRIND 0
+#endif
+
+#ifndef JHC_MEM_ANNOTATE
+#define JHC_MEM_ANNOTATE 0
+#endif
+
hunk ./src/rts/slub.c 2
-
-#ifdef JHC_VALGRIND
-#include <valgrind/valgrind.h>
-#include <valgrind/memcheck.h>
-#else
-#define VALGRIND_MAKE_MEM_UNDEFINED(x,y) \
-    do { } while (0)
-#define VALGRIND_MAKE_MEM_DEFINED(x,y) \
-    do { } while (0)
-#define VALGRIND_MAKE_MEM_NOACCESS(x,y) \
-    do { } while (0)
-#define VALGRIND_PRINTF(...) \
-    do { } while (0)
-#endif
-
hunk ./src/rts/slub.c 70
-        unsigned short num_ptrs;
hunk ./src/rts/slub.c 80
-        assert(*next_free < n);
+        assert(*next_free < (unsigned)n);
hunk ./src/rts/slub.c 214
-        unsigned header =  sizeof(struct s_block) + BITARRAY_SIZE_IN_BYTES(num_entries);
-        VALGRIND_MAKE_MEM_NOACCESS((char *)pg + header, BLOCK_SIZE - header);
+        if(JHC_VALGRIND) {
+                unsigned header =  sizeof(struct s_block) + BITARRAY_SIZE_IN_BYTES(num_entries);
+                VALGRIND_MAKE_MEM_NOACCESS((char *)pg + header, BLOCK_SIZE - header);
+        }
hunk ./src/rts/slub.c 226
-                //VALGRIND_MALLOCLIKE_BLOCK(pg,sizeof(struct s_block) + BITARRAY_SIZE_IN_BYTES(sc->num_entries), 0, 0);
-                VALGRIND_MAKE_MEM_UNDEFINED((char *)pg->used,BITARRAY_SIZE_IN_BYTES(sc->num_entries));
+                VALGRIND_MAKE_MEM_NOACCESS(pg, BLOCK_SIZE);
+                VALGRIND_MAKE_MEM_DEFINED(pg, sizeof(struct s_block));
+                if(sc->num_entries != pg->num_free)
+                        VALGRIND_MAKE_MEM_UNDEFINED((char *)pg->used,BITARRAY_SIZE_IN_BYTES(sc->num_entries));
+                else
+                        VALGRIND_MAKE_MEM_DEFINED((char *)pg->used,BITARRAY_SIZE_IN_BYTES(sc->num_entries));
hunk ./utils/debug.sh 1
-valgrind --db-command=cgdb  -x utils/debug.gdb -nw %f %p --db-attach=yes ./hs.out 2000
+#!/bin/sh
+valgrind --db-command="cgdb  -x utils/debug.gdb -nw %f %p" --db-attach=yes ./hs.out 2000