X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRtsUtils.c;h=a62a459be2d4de81870f9238d489533111d9f32e;hp=bf02c328fb45e0c4308f12bbaa03127c738fce8b;hb=b88025eabcd83f65d1d81f09272f5172f06a60e7;hpb=e3c55aebd4f9ce7a5b4390d4726612865fd207f2

diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c
index bf02c32..a62a459 100644
--- a/rts/RtsUtils.c
+++ b/rts/RtsUtils.c
@@ -45,6 +45,139 @@
 #endif
 
 /* -----------------------------------------------------------------------------
+   Debugging allocator
+   -------------------------------------------------------------------------- */
+
+#if defined(DEBUG)
+
+typedef struct Allocated_ {
+    void *addr;
+    size_t len;
+    struct Allocated_ *next;
+} Allocated;
+
+static Allocated *allocs = NULL;
+
+#ifdef THREADED_RTS
+static Mutex allocator_mutex;
+#endif
+
+void
+initAllocator(void)
+{
+    Allocated *a;
+    size_t alloc_size;
+
+#ifdef THREADED_RTS
+    initMutex(&allocator_mutex);
+#endif
+    alloc_size = sizeof(Allocated);
+    if ((a = (Allocated *) malloc(alloc_size)) == NULL) {
+      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
+      MallocFailHook((W_) alloc_size, "initialising debugging allocator");
+      stg_exit(EXIT_INTERNAL_ERROR);
+    }
+    a->addr = NULL;
+    a->len = 0;
+    a->next = NULL;
+    allocs = a;
+}
+
+void
+shutdownAllocator(void)
+{
+    Allocated *prev, *a;
+
+    if (allocs == NULL) {
+        barf("Allocator shutdown requested, but not initialised!");
+    }
+
+#ifdef THREADED_RTS
+    closeMutex(&allocator_mutex);
+#endif
+
+    prev = allocs;
+    while (1) {
+        a = prev->next;
+        free(prev);
+        if (a == NULL) return;
+        IF_DEBUG(sanity,
+                 debugBelch("Warning: %p still allocated at shutdown\n",
+                            a->addr);)
+        prev = a;
+    }
+}
+
+static void addAllocation(void *addr, size_t len) {
+    Allocated *a;
+    size_t alloc_size;
+
+    if (allocs != NULL) {
+        alloc_size = sizeof(Allocated);
+        if ((a = (Allocated *) malloc(alloc_size)) == NULL) {
+          /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
+          MallocFailHook((W_) alloc_size,
+                         "creating info for debugging allocator");
+          stg_exit(EXIT_INTERNAL_ERROR);
+        }
+        a->addr = addr;
+        a->len = len;
+        ACQUIRE_LOCK(&allocator_mutex);
+        a->next = allocs->next;
+        allocs->next = a;
+        RELEASE_LOCK(&allocator_mutex);
+    }
+    else {
+        /* This doesn't actually help as we haven't looked at the flags
+         * at the time that it matters (while running constructors) */
+        IF_DEBUG(sanity,
+                 debugBelch("Ignoring allocation %p %zd as allocs is NULL\n",
+                            addr, len);)
+    }
+}
+
+static void removeAllocation(void *addr, int overwrite_with_aa) {
+    Allocated *prev, *a;
+
+    if (addr == NULL) {
+        barf("Freeing NULL!");
+    }
+
+    if (allocs != NULL) {
+        ACQUIRE_LOCK(&allocator_mutex);
+        prev = allocs;
+        a = prev->next;
+        while (a != NULL) {
+            if (a->addr == addr) {
+                prev->next = a->next;
+                if (overwrite_with_aa) {
+                    memset(addr, 0xaa, a->len);
+                }
+                free(a);
+                RELEASE_LOCK(&allocator_mutex);
+                return;
+            }
+            prev = a;
+            a = a->next;
+        }
+        /* We would like to barf here, but we can't as conc021
+         * allocates some stuff in a constructor which then gets freed
+         * during hs_exit */
+        /* barf("Freeing non-allocated memory at %p", addr); */
+        IF_DEBUG(sanity,
+                 debugBelch("Warning: Freeing non-allocated memory at %p\n",
+                            addr);)
+        RELEASE_LOCK(&allocator_mutex);
+    }
+    else {
+        IF_DEBUG(sanity,
+                 debugBelch("Ignoring free of %p as allocs is NULL\n",
+                            addr);)
+    }
+}
+#endif
+
+/* -----------------------------------------------------------------------------
    Result-checking malloc wrappers.
    -------------------------------------------------------------------------- */
 
@@ -52,12 +185,17 @@ void *
 stgMallocBytes (int n, char *msg)
 {
     char *space;
+    size_t n2;
 
-    if ((space = (char *) malloc((size_t) n)) == NULL) {
+    n2 = (size_t) n;
+    if ((space = (char *) malloc(n2)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
       MallocFailHook((W_) n, msg); /*msg*/
       stg_exit(EXIT_INTERNAL_ERROR);
     }
+#if defined(DEBUG)
+    addAllocation(space, n2);
+#endif
     return space;
 }
 
@@ -65,12 +203,18 @@ void *
 stgReallocBytes (void *p, int n, char *msg)
 {
     char *space;
+    size_t n2;
 
-    if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
+    n2 = (size_t) n;
+    if ((space = (char *) realloc(p, (size_t) n2)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
       MallocFailHook((W_) n, msg); /*msg*/
       stg_exit(EXIT_INTERNAL_ERROR);
     }
+#if defined(DEBUG)
+    removeAllocation(p, 0);
+    addAllocation(space, n2);
+#endif
     return space;
 }
 
@@ -84,6 +228,9 @@ stgCallocBytes (int n, int m, char *msg)
       MallocFailHook((W_) n*m, msg); /*msg*/
       stg_exit(EXIT_INTERNAL_ERROR);
     }
+#if defined(DEBUG)
+    addAllocation(space, (size_t) n * (size_t) m);
+#endif
     return space;
 }
 
@@ -93,6 +240,9 @@ stgCallocBytes (int n, int m, char *msg)
 void
 stgFree(void* p)
 {
+#if defined(DEBUG)
+  removeAllocation(p, 1);
+#endif
   free(p);
 }