[MLton-commit] r6243

[Matthew Fluet]

Archival commit.

Wrap the default GMP memory management methods with debugging:
* 'if (DEBUG_INT_INF) sprintf(stderr, ...)' messages.
* 'assert (! isPointerInHeap(s, ptr))' for realloc and free.

Unfortunately, older versions of GMP don't include
'mp_get_memory_functions' to fetch the default memory management
methods.


----------------------------------------------------------------------

U   mlton/trunk/runtime/gc/init.c
U   mlton/trunk/runtime/gc/int-inf.c
U   mlton/trunk/runtime/gc/int-inf.h

----------------------------------------------------------------------

Modified: mlton/trunk/runtime/gc/init.c
===================================================================
--- mlton/trunk/runtime/gc/init.c	2007-12-07 21:21:52 UTC (rev 6242)
+++ mlton/trunk/runtime/gc/init.c	2007-12-09 18:20:20 UTC (rev 6243)
@@ -288,6 +288,7 @@
   s->weaks = NULL;
   s->saveWorldStatus = true;
 
+  initIntInf (s);
   initSignalStack (s);
   worldFile = NULL;
 

Modified: mlton/trunk/runtime/gc/int-inf.c
===================================================================
--- mlton/trunk/runtime/gc/int-inf.c	2007-12-07 21:21:52 UTC (rev 6242)
+++ mlton/trunk/runtime/gc/int-inf.c	2007-12-09 18:20:20 UTC (rev 6243)
@@ -363,3 +363,56 @@
   sp->header = GC_STRING8_HEADER;
   return pointerToObjptr ((pointer)&sp->obj, gcState.heap.start);
 }
+
+#ifdef DEBUG
+
+static GC_state intInfMemoryFuncsState;
+
+static void *(*alloc_func_ptr)(size_t) = NULL;
+static void *(*realloc_func_ptr)(void *, size_t, size_t) = NULL;
+static void (*free_func_ptr)(void *, size_t) = NULL;
+
+static void * wrap_alloc_func(size_t size) {
+  if (DEBUG_INT_INF)
+    fprintf (stderr, "alloc_func (size = %"PRIuMAX") = ", 
+             (uintmax_t)size);
+  void * res = (*alloc_func_ptr)(size);
+  if (DEBUG_INT_INF)
+    fprintf (stderr, FMTPTR"\n", (uintptr_t)res);
+  return res;
+}
+
+static void * wrap_realloc_func(void *ptr, size_t old_size, size_t new_size) {
+  if (DEBUG_INT_INF)
+    fprintf (stderr, "realloc_func (ptr = "FMTPTR", "
+             "old_size = %"PRIuMAX", new_size = %"PRIuMAX") = ", 
+             (uintptr_t)ptr, (uintmax_t)old_size, (uintmax_t)new_size);
+  assert (! isPointerInHeap(intInfMemoryFuncsState, (pointer)ptr));
+  void * res = (*realloc_func_ptr)(ptr, old_size, new_size);
+  if (DEBUG_INT_INF)
+    fprintf (stderr, FMTPTR"\n", (uintptr_t)res);
+  return res;
+}
+
+static void wrap_free_func(void *ptr, size_t size) {
+  if (DEBUG_INT_INF)
+    fprintf (stderr, "free_func (ptr = "FMTPTR", size = %"PRIuMAX")", 
+             (uintptr_t)ptr, (uintmax_t)size);
+  assert (! isPointerInHeap(intInfMemoryFuncsState, (pointer)ptr));
+  (*free_func_ptr)(ptr, size);
+  if (DEBUG_INT_INF)
+    fprintf (stderr, "\n");
+  return;
+}
+
+void initIntInf (GC_state s) {
+  intInfMemoryFuncsState = s;
+  mp_get_memory_functions (&alloc_func_ptr, &realloc_func_ptr, &free_func_ptr);
+  mp_set_memory_functions (&wrap_alloc_func, &wrap_realloc_func, &wrap_free_func);
+  return;
+}
+#else
+void initIntInf (__attribute__ ((unused)) GC_state s) {
+  return;
+}
+#endif

Modified: mlton/trunk/runtime/gc/int-inf.h
===================================================================
--- mlton/trunk/runtime/gc/int-inf.h	2007-12-07 21:21:52 UTC (rev 6242)
+++ mlton/trunk/runtime/gc/int-inf.h	2007-12-09 18:20:20 UTC (rev 6243)
@@ -56,6 +56,7 @@
         sizeof(mp_limb_t) >= sizeof(objptr) ? \
         1 : sizeof(objptr) / sizeof(mp_limb_t))
 
+void initIntInf (GC_state s);
 static inline void fillIntInfArg (GC_state s, objptr arg, __mpz_struct *res, 
                                   mp_limb_t space[LIMBS_PER_OBJPTR + 1]);
 static inline void initIntInfRes (GC_state s, __mpz_struct *res, size_t bytes);