[MLton-commit] r4107

Matthew Fluet MLton@mlton.org
Sat, 15 Oct 2005 17:47:39 -0700


Hash consing and sharing
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-10-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-10-16 00:47:35 UTC (rev 4107)
@@ -101,7 +101,9 @@
 	invariant.c   							\
 	enter_leave.c							\
 	cheney-copy.c							\
+	hash-cons.c							\
 	dfs-mark.c							\
+	share.c								\
 	assumptions.c							\
 	gc_suffix.c
 
@@ -125,8 +127,8 @@
 	controls.h							\
 	sysvals.h							\
 	ratios.h							\
+	hash-cons.h							\
 	gc_state.h							\
-	hash-cons.h							\
 	profile.h							\
 	gc_suffix.h
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-10-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-10-16 00:47:35 UTC (rev 4107)
@@ -22,6 +22,7 @@
   pointer limitPlusSlop; /* limit + LIMIT_SLOP */
   uint32_t maxFrameSize;
   /*Bool*/bool mutatorMarksCards;
+  GC_objectHashTable objectHashTable;
   GC_objectType *objectTypes; /* Array of object types. */
   uint32_t objectTypesLength; /* Cardinality of objectTypes array. */
   uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c	2005-10-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c	2005-10-16 00:47:35 UTC (rev 4107)
@@ -25,277 +25,282 @@
  *   we ensure by making it odd and keeping the table size as a power of 2.
  */
 
-static GC_ObjectHashTable newTable (GC_state s) {
-        int i;
-        uint maxElementsSize;
-        pointer regionStart;
-        pointer regionEnd;
-        GC_ObjectHashTable t;
-
-        NEW (GC_ObjectHashTable, t);
-        // Try to use space in the heap for the elements.
-        if (not (heapIsInit (&s->heap2))) {
-                if (DEBUG_SHARE)
-                        fprintf (stderr, "using heap2\n");
-                // We have all of heap2 available.  Use it.
-                regionStart = s->heap2.start;
-                regionEnd = s->heap2.start + s->heap2.size;
-        } else if (s->amInGC or not s->canMinor) {
-                if (DEBUG_SHARE)
-                        fprintf (stderr, "using end of heap\n");
-                regionStart = s->frontier;
-                regionEnd = s->limitPlusSlop;
-        } else {
-                if (DEBUG_SHARE)
-                        fprintf (stderr, "using minor space\n");
-                // Use the space available for a minor GC.
-                assert (s->canMinor);
-                regionStart = s->heap.start + s->oldGenSize;
-                regionEnd = s->nursery;
-        }
-        maxElementsSize = (regionEnd - regionStart) / sizeof (*(t->elements));
-        if (DEBUG_SHARE)
-                fprintf (stderr, "maxElementsSize = %u\n", maxElementsSize);
-        t->elementsSize = 64;  // some small power of two
-        t->log2ElementsSize = 6;  // and its log base 2
-        if (maxElementsSize < t->elementsSize) {
-                if (DEBUG_SHARE)
-                        fprintf (stderr, "too small -- using malloc\n");
-                t->elementsIsInHeap = FALSE;
-                ARRAY (struct GC_ObjectHashElement *, t->elements, t->elementsSize);
-        } else {
-                t->elementsIsInHeap = TRUE;
-                t->elements = (struct GC_ObjectHashElement*)regionStart;
-                // Find the largest power of two that fits.
-                for (; t->elementsSize <= maxElementsSize; 
-                        t->elementsSize <<= 1, t->log2ElementsSize++)
-                        ; // nothing
-                t->elementsSize >>= 1;
-                t->log2ElementsSize--;
-                assert (t->elementsSize <= maxElementsSize);
-                for (i = 0; i < t->elementsSize; ++i)
-                        t->elements[i].object = NULL;
-        }
-        t->numElements = 0;
-        t->mayInsert = TRUE;
-        if (DEBUG_SHARE) {
-                fprintf (stderr, "elementsIsInHeap = %s\n", 
-                                boolToString (t->elementsIsInHeap));
-                fprintf (stderr, "elementsSize = %u\n", t->elementsSize);
-                fprintf (stderr, "0x%08x = newTable ()\n", (uint)t);
-        }
-        return t;
+static GC_objectHashTable newHashTable (GC_state s) {
+  uint32_t elementsLengthMax;
+  pointer regionStart;
+  pointer regionEnd;
+  GC_objectHashTable t;
+  
+  t = (GC_objectHashTable)(malloc_safe (sizeof(*t)));
+  // Try to use space in the heap for the elements.
+  if (not (heapIsInit (&s->secondaryHeap))) {
+    if (DEBUG_SHARE)
+      fprintf (stderr, "using secondaryHeap\n");
+    regionStart = s->secondaryHeap.start;
+    regionEnd = s->secondaryHeap.start + s->secondaryHeap.size;
+  } else if (s->amInGC or not s->canMinor) {
+    if (DEBUG_SHARE)
+      fprintf (stderr, "using end of heap\n");
+    regionStart = s->frontier;
+    regionEnd = s->limitPlusSlop;
+  } else {
+    if (DEBUG_SHARE)
+      fprintf (stderr, "using minor space\n");
+    assert (s->canMinor);
+    regionStart = s->heap.start + s->heap.oldGenSize;
+    regionEnd = s->heap.nursery;
+  }
+  elementsLengthMax = (regionEnd - regionStart) / sizeof (*(t->elements));
+  if (DEBUG_SHARE)
+    fprintf (stderr, "elementsLengthMax = %"PRIu32"\n", elementsLengthMax);
+  t->elementsLengthMax = 64;  // some small power of two
+  t->elementsLengthMaxLog2 = 6;  // and its log base 2
+  if (elementsLengthMax < t->elementsLengthMax) {
+    if (DEBUG_SHARE)
+      fprintf (stderr, "too small -- using malloc\n");
+    t->elementsIsInHeap = FALSE;
+    t->elements = 
+      (struct GC_objectHashElement *)
+      (calloc_safe(t->elementsLengthMax, sizeof(*(t->elements))));
+  } else {
+    t->elementsIsInHeap = TRUE;
+    t->elements = (struct GC_objectHashElement*)regionStart;
+    // Find the largest power of two that fits.
+    for ( ; 
+         t->elementsLengthMax <= elementsLengthMax; 
+         t->elementsLengthMax <<= 1, t->elementsLengthMaxLog2++)
+      ; // nothing
+    t->elementsLengthMax >>= 1;
+    t->elementsLengthMaxLog2--;
+    assert (t->elementsLengthMax <= elementsLengthMax);
+    for (unsigned int i = 0; i < t->elementsLengthMax; ++i)
+      t->elements[i].object = NULL;
+  }
+  t->elementsLengthCur = 0;
+  t->mayInsert = TRUE;
+  if (DEBUG_SHARE) {
+    fprintf (stderr, "elementsIsInHeap = %s\n", 
+             boolToString (t->elementsIsInHeap));
+    fprintf (stderr, "elementsLengthMax = %"PRIu32"\n", t->elementsLengthMax);
+    fprintf (stderr, FMTPTR" = newHashTable ()\n", (uintptr_t)t);
+  }
+  return t;
 }
 
-static void destroyTable (GC_ObjectHashTable t) {
-        unless (t->elementsIsInHeap)
-                free (t->elements);
-        free (t);
+static void destroyHashTable (GC_objectHashTable t) {
+  unless (t->elementsIsInHeap)
+    free (t->elements);
+  free (t);
 }
 
-static inline Pointer tableInsert 
-        (GC_state s, GC_ObjectHashTable t, W32 hash, Pointer object, 
-                Bool mightBeThere, Header header, W32 tag, Pointer max) {
-        GC_ObjectHashElement e;
-        Header header2;
-        static Bool init = FALSE;
-        static int maxNumProbes = 0;
-        static W64 mult; // magic multiplier for hashing
-        int numProbes;
-        W32 probe;
-        word *p;
-        word *p2;
-        W32 slot; // slot in hash table we are considering
+static inline pointer 
+tableInsert (GC_state s, GC_objectHashTable t, 
+             GC_hash hash, pointer object,
+             bool mightBeThere, GC_header header, GC_objectTypeTag tag, pointer max) {
+  static bool init = FALSE;
+  static uint64_t mult; // magic multiplier for hashing
+  static uint32_t maxNumProbes = 0;
 
-        if (DEBUG_SHARE)
-                fprintf (stderr, "tableInsert (%u, 0x%08x, %s, 0x%08x, 0x%08x)\n",
-                                (uint)hash, (uint)object, 
-                                boolToString (mightBeThere),
-                                (uint)header, (uint)max);
-        if (! init) {
-                init = TRUE;
-                mult = floor (((sqrt (5.0) - 1.0) / 2.0)
-                                * (double)0x100000000llu);
-        }
-        slot = (W32)(mult * (W64)hash) >> (32 - t->log2ElementsSize);
-        probe = (1 == slot % 2) ? slot : slot - 1;
-        if (DEBUG_SHARE)
-                fprintf (stderr, "probe = 0x%08x\n", (uint)probe);
-        assert (1 == probe % 2);
-        numProbes = 0;
+  GC_objectHashElement e;
+  uint32_t numProbes;
+  uint32_t probe;
+  uint32_t slot; // slot in the hash table we are considering
+  unsigned int *p1;
+  unsigned int *p2;
+  
+  if (DEBUG_SHARE)
+    fprintf (stderr, "tableInsert ("FMTHASH", "FMTPTR", %s, "FMTHDR", "FMTPTR")\n",
+             hash, (uintptr_t)object,
+             boolToString (mightBeThere),
+             header, (uintptr_t)max);
+  if (! init) {
+    init = TRUE;
+    mult = floor (((sqrt (5.0) - 1.0) / 2.0)
+                  * (double)0x100000000llu);
+  }
+  slot = (uint32_t)(mult * (uint64_t)hash) >> (32 - t->elementsLengthMaxLog2);
+  probe = (1 == slot % 2) ? slot : slot - 1;
+  if (DEBUG_SHARE)
+    fprintf (stderr, "probe = 0x%08x\n", (uint)probe);
+  assert (1 == probe % 2);
+  numProbes = 0;
 look:
-        if (DEBUG_SHARE)
-                fprintf (stderr, "slot = 0x%08x\n", (uint)slot);
-        assert (0 <= slot and slot < t->elementsSize);
-        numProbes++;
-        e = &t->elements[slot];
-        if (NULL == e->object) {
-                /* It's not in the table.  Add it. */
-                unless (t->mayInsert) {
-                        if (DEBUG_SHARE)
-                                fprintf (stderr, "not inserting\n");
-                        return object;
-                }
-                e->hash = hash;
-                e->object = object;
-                t->numElements++;
-                if (numProbes > maxNumProbes) {
-                        maxNumProbes = numProbes;
-                        if (DEBUG_SHARE)
-                                fprintf (stderr, "numProbes = %d\n", numProbes);
-                }
-                return object;
-        }
-        unless (hash == e->hash) {
+  if (DEBUG_SHARE)
+    fprintf (stderr, "slot = 0x%"PRIx32"\n", slot);
+  assert (slot < t->elementsLengthMax);
+  numProbes++;
+  e = &t->elements[slot];
+  if (NULL == e->object) {
+    /* It's not in the table.  Add it. */
+    unless (t->mayInsert) {
+      if (DEBUG_SHARE)
+        fprintf (stderr, "not inserting\n");
+      return object;
+    }
+    e->hash = hash;
+    e->object = object;
+    t->elementsLengthCur++;
+    if (numProbes > maxNumProbes) {
+      maxNumProbes = numProbes;
+      if (DEBUG_SHARE)
+        fprintf (stderr, "numProbes = %"PRIu32"\n", numProbes);
+    }
+    return object;
+  }
+  unless (hash == e->hash) {
 lookNext:
-                slot = (slot + probe) % t->elementsSize;
-                goto look;
-        }
-        unless (mightBeThere)
-                goto lookNext;
-        if (DEBUG_SHARE)
-                fprintf (stderr, "comparing 0x%08x to 0x%08x\n",
-                                (uint)object, (uint)e->object);
-        /* Compare object to e->object. */
-        unless (object == e->object) {
-                header2 = GC_getHeader (e->object);
-                unless (header == header2)
-                        goto lookNext;
-                for (p = (word*)object, p2 = (word*)e->object; 
-                                p < (word*)max; 
-                                ++p, ++p2)
-                        unless (*p == *p2)
-                                goto lookNext;
-                if (ARRAY_TAG == tag
-                        and (GC_arrayNumElements (object)
-                                != GC_arrayNumElements (e->object)))
-                        goto lookNext;
-        }
-        /* object is equal to e->object. */
-        return e->object;
+    slot = (slot + probe) % t->elementsLengthMax;
+    goto look;
+  }
+  unless (mightBeThere)
+    goto lookNext;
+  if (DEBUG_SHARE)
+    fprintf (stderr, "comparing "FMTPTR" to "FMTPTR"\n",
+             (uintptr_t)object, (uintptr_t)e->object);
+  /* Compare object to e->object. */
+  unless (object == e->object) {
+    unless (header == getHeader (e->object))
+      goto lookNext;
+    for (p1 = (unsigned int*)object, 
+         p2 = (unsigned int*)e->object;
+         p1 < (unsigned int*)max;
+         ++p1, ++p2)
+      unless (*p1 == *p2)
+        goto lookNext;
+    if (ARRAY_TAG == tag
+        and (getArrayLength (object) != getArrayLength (e->object)))
+      goto lookNext;
+  }
+  /* object is equal to e->object. */
+  return e->object;
 }
 
-static void maybeGrowTable (GC_state s, GC_ObjectHashTable t) { 
-        int i;
-        GC_ObjectHashElement oldElement;
-        struct GC_ObjectHashElement *oldElements;
-        uint oldSize;
-        uint newSize;
-
-        if (not t->mayInsert or t->numElements * 2 <= t->elementsSize)
-                return;
-        oldElements = t->elements;
-        oldSize = t->elementsSize;
-        newSize = oldSize * 2;
-        if (DEBUG_SHARE)
-                fprintf (stderr, "trying to grow table to size %d\n", newSize);
-        // Try to alocate the new table.
-        ARRAY_UNSAFE (struct GC_ObjectHashElement *, t->elements, newSize);
-        if (NULL == t->elements) {
-                t->mayInsert = FALSE;
-                t->elements = oldElements;
-                if (DEBUG_SHARE)
-                        fprintf (stderr, "unable to grow table\n");
-                return;
-        }
-        t->elementsSize = newSize;
-        t->log2ElementsSize++;
-        for (i = 0; i < oldSize; ++i) {
-                oldElement = &oldElements[i];
-                unless (NULL == oldElement->object)
-                        tableInsert (s, t, oldElement->hash, oldElement->object,
-                                        FALSE, 0, 0, 0);
-        }
-        if (t->elementsIsInHeap)
-                t->elementsIsInHeap = FALSE;
-        else
-                free (oldElements);
-        if (DEBUG_SHARE)
-                fprintf (stderr, "done growing table\n");
+static void maybeGrowTable (GC_state s, GC_objectHashTable t) {
+  GC_objectHashElement oldElement;
+  struct GC_objectHashElement *oldElements;
+  uint32_t oldElementsLengthMax;
+  uint32_t newElementsLengthMax;
+  
+  if (not t->mayInsert or t->elementsLengthCur * 2 <= t->elementsLengthMax)
+    return;
+  oldElements = t->elements;
+  oldElementsLengthMax = t->elementsLengthMax;
+  newElementsLengthMax = oldElementsLengthMax * 2;
+  if (DEBUG_SHARE)
+    fprintf (stderr, 
+             "trying to grow table to cardinality %"PRIu32"\n", 
+             newElementsLengthMax);
+  // Try to alocate the new table.
+  t->elements =
+    (struct GC_objectHashElement *)
+    (calloc(newElementsLengthMax, sizeof(*(t->elements))));
+  if (NULL == t->elements) {
+    t->mayInsert = FALSE;
+    t->elements = oldElements;
+    if (DEBUG_SHARE)
+      fprintf (stderr, "unable to grow table\n");
+    return;
+  }
+  t->elementsLengthMax = newElementsLengthMax;
+  t->elementsLengthMaxLog2++;
+  for (unsigned int i = 0; i < oldElementsLengthMax; ++i) {
+    oldElement = &oldElements[i];
+    unless (NULL == oldElement->object)
+      tableInsert (s, t, oldElement->hash, oldElement->object,
+                   FALSE, 0, 0, NULL);
+  }
+  if (t->elementsIsInHeap)
+    t->elementsIsInHeap = FALSE;
+  else
+    free (oldElements);
+  if (DEBUG_SHARE)
+    fprintf (stderr, "done growing table\n");
 }
 
-static Pointer hashCons (GC_state s, Pointer object, Bool countBytesHashConsed) {
-        Bool hasIdentity;
-        Word32 hash;
-        Header header;
-        pointer max;
-        uint numNonPointers;
-        uint numPointers;
-        word *p;
-        Pointer res;
-        GC_ObjectHashTable t;
-        uint tag;
+static pointer hashCons (GC_state s, pointer object, bool countBytesHashConsed) {
+  GC_objectHashTable t;
+  GC_header header;
+  uint16_t numNonObjptrs;
+  uint16_t numObjptrs;
+  bool hasIdentity;
+  GC_objectTypeTag tag;
+  pointer max;
+  GC_hash hash;
+  GC_hash* p;
+  pointer res;
 
-        if (DEBUG_SHARE)
-                fprintf (stderr, "hashCons (0x%08x)\n", (uint)object);
-        t = s->objectHashTable;
-        header = GC_getHeader (object);
-        SPLIT_HEADER ();
-        if (hasIdentity) {
-                /* Don't hash cons. */
-                res = object;
-                goto done;
-        }
-        assert (ARRAY_TAG == tag or NORMAL_TAG == tag);
-        max = object
-                + (ARRAY_TAG == tag
-                        ? arrayNumBytes (s, object,
-                                                numPointers, numNonPointers)
-                        : toBytes (numPointers + numNonPointers));
-        // Compute the hash.
-        hash = header;
-        for (p = (word*)object; p < (word*)max; ++p)
-                hash = hash * 31 + *p;
-        /* Insert into table. */
-        res = tableInsert (s, t, hash, object, TRUE, header, tag, (Pointer)max);
-        maybeGrowTable (s, t);
-        if (countBytesHashConsed and res != object) {
-                uint amount;
-
-                amount = max - object;
-                if (ARRAY_TAG == tag)
-                        amount += GC_ARRAY_HEADER_SIZE;
-                else
-                        amount += GC_NORMAL_HEADER_SIZE;
-                s->bytesHashConsed += amount;
-        }
+  if (DEBUG_SHARE)
+    fprintf (stderr, "hashCons ("FMTPTR")\n", (uintptr_t)object);
+  t = s->objectHashTable;
+  header = getHeader (object);
+  splitHeader(s, header, &tag, &hasIdentity, &numNonObjptrs, &numObjptrs);
+  if (hasIdentity) {
+    /* Don't hash cons. */
+    res = object;
+    goto done;
+  }
+  assert (ARRAY_TAG == tag or NORMAL_TAG == tag);
+  max = 
+    object
+    + (ARRAY_TAG == tag
+       ? arraySizeNoHeader (s, object,
+                            numNonObjptrs, numObjptrs)
+       : (numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+          + (numObjptrs * OBJPTR_SIZE)));
+  // Compute the hash.
+  hash = (GC_hash)header;
+  for (p = (GC_hash*)object; p < (GC_hash*)max; ++p)
+    hash = hash * 31 + *p;
+  /* Insert into table. */
+  res = tableInsert (s, t, hash, object, TRUE, header, tag, max);
+  maybeGrowTable (s, t);
+  if (countBytesHashConsed and res != object) {
+    size_t amount;
+    
+    amount = max - object;
+    if (ARRAY_TAG == tag)
+      amount += GC_ARRAY_HEADER_SIZE;
+    else
+      amount += GC_NORMAL_HEADER_SIZE;
+    s->cumulativeStatistics.bytesHashConsed += amount;
+  }
 done:
-        if (DEBUG_SHARE)
-                fprintf (stderr, "0x%08x = hashCons (0x%08x)\n", 
-                                (uint)res, (uint)object);
-        return res;
+  if (DEBUG_SHARE)
+    fprintf (stderr, FMTPTR" = hashCons ("FMTPTR")\n",
+             (uintptr_t)res, (uintptr_t)object);
+  return res;
 }
 
 static inline void maybeSharePointer (GC_state s,
-                                        Pointer *pp, 
-                                        Bool shouldHashCons) {
-        unless (shouldHashCons)
-                return;
-        if (DEBUG_SHARE)
-                fprintf (stderr, "maybeSharePointer  pp = 0x%08x  *pp = 0x%08x\n",
-                                (uint)pp, (uint)*pp);
-        *pp = hashCons (s, *pp, FALSE); 
+                                      pointer *pp,
+                                      bool shouldHashCons) {
+  unless (shouldHashCons)
+    return;
+  if (DEBUG_SHARE)
+    fprintf (stderr, "maybeSharePointer  pp = "FMTPTR"  *pp = "FMTPTR"\n",
+             (uintptr_t)pp, (uintptr_t)*pp);
+  *pp = hashCons (s, *pp, FALSE);
 }
 
-static void bytesHashConsedMessage (GC_state s, ullong total) {
-        fprintf (stderr, "%s bytes hash consed (%.1f%%).\n",
-                ullongToCommaString (s->bytesHashConsed),
-                100.0 * ((double)s->bytesHashConsed / (double)total));
+static inline void maybeShareObjptr (GC_state s,
+                                     objptr *opp,
+                                     bool shouldHashCons) {
+  pointer p;
+  
+  unless (shouldHashCons)
+    return;
+  p = objptrToPointer (*opp, s->heap.start);
+  if (DEBUG_SHARE)
+    fprintf (stderr, "maybeShareObjptr  opp = "FMTPTR"  *opp = "FMTOBJPTR"\n",
+             (uintptr_t)opp, *opp);
+  p = hashCons (s, p, FALSE);
+  *opp = pointerToObjptr (p, s->heap.start);
 }
 
-void GC_share (GC_state s, Pointer object) {
-        W32 total;
-
-        if (DEBUG_SHARE)
-                fprintf (stderr, "GC_share 0x%08x\n", (uint)object);
-        if (DEBUG_SHARE or s->messages)
-                s->bytesHashConsed = 0;
-        // Don't hash cons during the first round of marking.
-        total = mark (s, object, MARK_MODE, FALSE);
-        s->objectHashTable = newTable (s);
-        // Hash cons during the second round of marking.
-        mark (s, object, UNMARK_MODE, TRUE);
-        destroyTable (s->objectHashTable);
-        if (DEBUG_SHARE or s->messages)
-                bytesHashConsedMessage (s, total);
+static void bytesHashConsedMessage (GC_state s, uintmax_t total) {
+  fprintf (stderr, "%"PRIuMAX" bytes hash consed (%.1f%%).\n",
+           /*ullongToCommaString*/(s->cumulativeStatistics.bytesHashConsed),
+           (100.0 
+            * ((double)s->cumulativeStatistics.bytesHashConsed 
+               / (double)total)));
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h	2005-10-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h	2005-10-16 00:47:35 UTC (rev 4107)
@@ -11,6 +11,9 @@
 /* ---------------------------------------------------------------- */
 
 typedef uint32_t GC_hash;
+#define GC_HASH_SIZE sizeof(GC_hash)
+#define PRIxHASH PRIx32
+#define FMTHASH "0x%08"PRIxHASH
 
 typedef struct GC_objectHashElement {
   GC_hash hash;
@@ -20,14 +23,14 @@
 typedef struct GC_objectHashTable {
   struct GC_objectHashElement *elements;
   bool elementsIsInHeap;
-  size_t elementsSize;
-  int log2ElementsSize;
+  uint32_t elementsLengthCur;
+  uint32_t elementsLengthMax;
+  uint32_t elementsLengthMaxLog2;
   bool mayInsert;
-  int32_t numElements;
-} *GC_ObjectHashTable;
+} *GC_objectHashTable;
 
-pointer hashCons (GC_state s, pointer object,
-                  bool countBytesHashConsed);
+/*
 void maybeShareObjptr (GC_state s,
                        objptr *opp,
                        bool shouldHashCons);
+*/

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c (from rev 4106, mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c	2005-10-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c	2005-10-16 00:47:35 UTC (rev 4107)
@@ -0,0 +1,24 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+void GC_share (GC_state s, pointer object) {
+  size_t total;
+  
+  if (DEBUG_SHARE)
+    fprintf (stderr, "GC_share "FMTPTR"\n", (uintptr_t)object);
+  if (DEBUG_SHARE or s->controls.messages)
+    s->cumulativeStatistics.bytesHashConsed = 0;
+  // Don't hash cons during the first round of marking.
+  total = mark (s, object, MARK_MODE, FALSE);
+  s->objectHashTable = newHashTable (s);
+  // Hash cons during the second round of marking.
+  mark (s, object, UNMARK_MODE, TRUE);
+  destroyHashTable (s->objectHashTable);
+  if (DEBUG_SHARE or s->controls.messages)
+    bytesHashConsedMessage (s, total);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h	2005-10-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h	2005-10-16 00:47:35 UTC (rev 4107)
@@ -25,6 +25,7 @@
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
+#include <math.h>
 #include <sys/resource.h>
 
 #include "../assert.h"

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c	2005-10-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c	2005-10-16 00:47:35 UTC (rev 4107)
@@ -29,3 +29,22 @@
   }
   return result;
 }
+
+void *calloc_safe (size_t count, size_t size) {
+  void *res;
+  
+  res = calloc (count, size);
+  if (NULL == res)
+    die ("calloc (%zu, %zu) failed.\n", 
+         count, size);
+  return res;
+}
+
+void *malloc_safe (size_t size) {
+  void *res;
+  
+  res = malloc (size);
+  if (NULL == res)
+    die ("malloc (%zu) failed.\n", size);
+  return res;
+}