[MLton-commit] r4099

Matthew Fluet MLton@mlton.org
Sun, 9 Oct 2005 12:59:28 -0700


Some heap management
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-10-09 19:59:19 UTC (rev 4099)
@@ -73,22 +73,28 @@
 ## Order matters, as these are concatenated together to form "gc.c".
 CFILES = 								\
 	gc_prefix.c							\
+	util.c								\
 	debug.c								\
 	align.c								\
+	virtual-memory.c						\
 	pointer.c							\
 	model.c								\
 	object.c							\
 	array.c								\
+	object_size.c							\
 	frame.c								\
 	stack.c								\
 	thread.c							\
 	generational.c							\
 	heap.c   							\
+	gc_state.c   							\
+	new_object.c   							\
 	ratios.c   							\
-	gc_state.c   							\
 	current.c   							\
 	foreach.c							\
+	atomic.c							\
 	invariant.c   							\
+	enter_leave.c							\
 	cheney-copy.c							\
 	assumptions.c							\
 	gc_suffix.c
@@ -106,14 +112,15 @@
 	stack.h								\
 	thread.h							\
 	weak.h								\
+	heap.h								\
 	major.h								\
 	generational.h							\
 	statistics.h							\
-	heap.h								\
 	control.h							\
 	sysvals.h							\
 	ratios.h							\
 	gc_state.h							\
+	profile.h							\
 	gc_suffix.h
 
 all: gc.o gc-gdb.o

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -17,30 +17,17 @@
   return a;       
 }
 
-/*
-static inline W64 w64align (W64 a, uint b) {
-        W64 res;
-
-        assert (a >= 0);
-        assert (b >= 1);
-        res = a + b - 1;
-        res = res - res % b;
-        if (FALSE)
-                fprintf (stderr, "%llu = w64Align (%llu, %u)\n", res, a, b);
-        return res;
-}
-*/
-
 static inline bool isAligned (size_t a, size_t b) {
   return 0 == a % b;
 }
 
 #if ASSERT
 static inline bool isAlignedFrontier (GC_state s, pointer p) {
-  return isAligned ((uintptr_t)p + GC_NORMAL_HEADER_SIZE, s->alignment);
+  return isAligned ((uintptr_t)p + GC_NORMAL_HEADER_SIZE, 
+                    s->alignment);
 }
 
-static bool isAlignedReserved (GC_state s, size_t reserved) {
+static inline bool isAlignedReserved (GC_state s, size_t reserved) {
   return isAligned (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved, 
                     s->alignment);
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -52,32 +52,3 @@
     result = OBJPTR_SIZE;
   return pad (s, result, GC_ARRAY_HEADER_SIZE);
 }
-
-static inline size_t objectSize (GC_state s, pointer p) {
-  size_t headerBytes, objectBytes;
-  GC_header header;
-  GC_objectTypeTag tag;
-  uint16_t numNonObjptrs, numObjptrs;
-  
-  header = getHeader (p);
-  splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
-  if (NORMAL_TAG == tag) { /* Fixed size object. */
-    headerBytes = GC_NORMAL_HEADER_SIZE;
-    objectBytes = 
-      numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
-      + (numObjptrs * OBJPTR_SIZE);
-  } else if (ARRAY_TAG == tag) {
-    headerBytes = GC_ARRAY_HEADER_SIZE;
-    objectBytes = arrayNumBytes (s, p, numNonObjptrs, numObjptrs);
-  } else if (WEAK_TAG == tag) {
-    headerBytes = GC_NORMAL_HEADER_SIZE;
-    objectBytes = 
-      numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
-      + (numObjptrs * OBJPTR_SIZE);
-  } else { /* Stack. */
-    assert (STACK_TAG == tag);
-    headerBytes = GC_STACK_HEADER_SIZE;
-    objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
-  }
-  return headerBytes + objectBytes;
-}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c (from rev 4098, mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,54 @@
+/* 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.
+ */
+
+#if ASSERT
+static inline pointer arrayIndexAtPointer (GC_state s, 
+                                           pointer a, 
+                                           uint32_t arrayIndex, 
+                                           uint32_t pointerIndex) {
+  GC_header header;
+  uint16_t numNonObjptrs;
+  uint16_t numObjptrs;
+  GC_objectTypeTag tag;
+  
+  header = getHeader (a);
+  splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+  assert (tag == ARRAY_TAG);
+
+  size_t nonObjptrBytesPerElement =
+    numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
+  size_t bytesPerElement = 
+    nonObjptrBytesPerElement
+    + (numObjptrs * OBJPTR_SIZE);
+
+  return a
+    + arrayIndex * bytesPerElement
+    + nonObjptrBytesPerElement
+    + pointerIndex * OBJPTR_SIZE;
+}
+#endif
+
+/* The number of bytes in an array, not including the header. */
+static inline size_t arrayNumBytes (GC_state s,
+                                    pointer p, 
+                                    uint16_t numNonObjptrs,
+                                    uint16_t numObjptrs) {
+  size_t bytesPerElement;
+  GC_arrayLength numElements;
+  size_t result;
+        
+  numElements = getArrayLength (p);
+  bytesPerElement = 
+    numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG) 
+    + (numObjptrs * OBJPTR_SIZE);
+  result = numElements * bytesPerElement;
+  /* Empty arrays have OBJPTR_SIZE bytes for the forwarding pointer. */
+  if (0 == result) 
+    result = OBJPTR_SIZE;
+  return pad (s, result, GC_ARRAY_HEADER_SIZE);
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,19 @@
+/* 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.
+ */
+
+static inline void atomicBegin (GC_state s) {
+  s->atomicState++;
+  if (0 == s->limit)
+    s->limit = s->limitPlusSlop - LIMIT_SLOP;
+}
+
+static inline void atomicEnd (GC_state s) {
+  s->atomicState--;
+  if (0 == s->atomicState and s->signalIsPending)
+    s->limit = 0;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -169,7 +169,7 @@
     } else {
       if (DEBUG_WEAK)
         fprintf (stderr, "cleared\n");
-      *(getHeaderp(p)) = WEAK_GONE_HEADER;
+      *(getHeaderp(p)) = GC_WEAK_GONE_HEADER;
       w->objptr = BOGUS_OBJPTR;
     }
   }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -28,3 +28,16 @@
 static inline size_t currentStackUsed (GC_state s) {
   return s->stackTop - s->stackBottom;
 }
+
+static void setCurrentStack (GC_state s) {
+  GC_thread thread;
+  GC_stack stack;
+  
+  thread = currentThread (s);
+  s->exnStack = thread->exnStack;
+  stack = currentThreadStack (s);
+  s->stackBottom = stackBottom (s, stack);
+  s->stackTop = stackTop (s, stack);
+  s->stackLimit = stackLimit (s, stack);
+  markCard (s, (pointer)stack);
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,39 @@
+/* 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.
+ */
+
+/* enter and leave should be called at the start and end of every GC
+ * function that is exported to the outside world.  They make sure
+ * that the function is run in a critical section and check the GC
+ * invariant.
+ */
+static void enter (GC_state s) {
+
+  if (DEBUG)
+    fprintf (stderr, "enter\n");
+  /* used needs to be set because the mutator has changed s->stackTop. */
+  currentThreadStack(s)->used = currentStackUsed (s);
+  currentThread(s)->exnStack = s->exnStack;
+  if (DEBUG) 
+    displayGCState (s, stderr);
+  atomicBegin (s);
+  assert (invariant (s));
+  if (DEBUG)
+    fprintf (stderr, "enter ok\n");
+}
+
+static void leave (GC_state s) {
+  if (DEBUG)
+    fprintf (stderr, "leave\n");
+  /* The mutator frontier invariant may not hold
+   * for functions that don't ensureBytesFree.
+   */
+  assert (mutatorInvariant (s, FALSE, TRUE));
+  atomicEnd (s);
+  if (DEBUG)
+    fprintf (stderr, "leave ok\n");
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -59,7 +59,7 @@
              "  tag = %s"
              "  numNonObjptrs = %d"
              "  numObjptrs = %d\n", 
-             (uintptr_t)p, header, tagToString (tag), 
+             (uintptr_t)p, header, objectTypeTagToString (tag), 
              numNonObjptrs, numObjptrs);
   if (NORMAL_TAG == tag) {
     p += numNonObjptrsToBytes(numNonObjptrs, NORMAL_TAG);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -3,3 +3,8 @@
 static inline size_t maxZ (size_t x, size_t y) {
   return ((x < y) ? x : y);
 }
+
+static inline size_t meg (size_t n) {
+  return n / (1024ul * 1024ul);
+}
+

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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-10-09 19:59:19 UTC (rev 4099)
@@ -3,11 +3,13 @@
   size_t alignment; /* */
   bool amInGC;
   bool amInMinorGC;
+  uint32_t atomicState;
   objptr callFromCHandlerThread; /* Handler for exported C calls (in heap). */
   bool canMinor; /* TRUE iff there is space for a minor gc. */
   struct GC_control control;
   struct GC_cumulativeStatistics cumulativeStatistics;
   objptr currentThread; /* Currently executing thread (in heap). */
+  uint32_t exnStack;
   GC_frameLayout *frameLayouts; /* Array of frame layouts. */
   uint32_t frameLayoutsLength; /* Cardinality of frameLayouts array. */
   pointer frontier; /* heap.start <= frontier < limit */
@@ -31,6 +33,7 @@
                        */
   struct GC_heap secondaryHeap; /* Used for major copying collection. */
   objptr signalHandlerThread; /* Handler for signals (in heap). */
+  /*Bool*/bool signalIsPending;
   pointer stackBottom; /* Bottom of stack in current thread. */
   pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */
   pointer stackTop; /* Top of stack in current thread. */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -55,7 +55,7 @@
 }
 
 #if ASSERT
-static bool hasBytesFree (GC_state s, size_t oldGen, size_t nursery) {
+static bool heapHasBytesFree (GC_state s, size_t oldGen, size_t nursery) {
   size_t total;
   bool res;
 
@@ -67,7 +67,7 @@
     and (nursery <= (size_t)(s->limitPlusSlop - s->frontier));
   if (DEBUG_DETAILED)
     fprintf (stderr, "%s = hasBytesFree (%zd, %zd)\n",
-             res ? "true" : "false",
+             boolToString (res),
              /*uintToCommaString*/(oldGen),
              /*uintToCommaString*/(nursery));
   return res;
@@ -268,5 +268,69 @@
   s->frontier = s->heap.nursery;
   assert (nurseryBytesRequested <= (size_t)(s->limitPlusSlop - s->frontier));
   assert (isAlignedFrontier (s, s->heap.nursery));
-  assert (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
+  assert (heapHasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
 }
+
+/* heapCreate (s, h, desiredSize, minSize) 
+ * 
+ * allocates a heap of the size necessary to work with desiredSize
+ * live data, and ensures that at least minSize is available.  It
+ * returns TRUE if it is able to allocate the space, and returns FALSE
+ * if it is unable.  If a reasonable size to space is already there,
+ * then heapCreate leaves it.
+ */
+static bool heapCreate (GC_state s, GC_heap h, 
+                        size_t desiredSize, 
+                        size_t minSize) {
+  size_t backoff;
+
+  if (DEBUG_MEM)
+    fprintf (stderr, "heapCreate  desired size = %zd  min size = %zd\n",
+             /*uintToCommaString*/(desiredSize),
+             /*uintToCommaString*/(minSize));
+  assert (heapIsInit (h));
+  if (desiredSize < minSize)
+    desiredSize = minSize;
+  desiredSize = align (desiredSize, s->sysvals.pageSize);
+  assert (0 == h->size and NULL == h->start);
+  backoff = (desiredSize - minSize) / 20;
+  if (0 == backoff)
+    backoff = 1; /* enough to terminate the loop below */
+  backoff = align (backoff, s->sysvals.pageSize);
+  /* mmap toggling back and forth between high and low addresses to
+   * decrease the chance of virtual memory fragmentation causing an mmap
+   * to fail.  This is important for large heaps.
+   */
+  for (h->size = desiredSize; h->size >= minSize; h->size -= backoff) {
+    static bool direction = TRUE;
+    unsigned int i;
+
+    assert (isAligned (h->size, s->sysvals.pageSize));
+    for (i = 0; i < 32; i++) {
+      size_t address;
+      
+      address = i * 0x08000000ul;
+      if (direction)
+        address = 0xf8000000ul - address;
+      h->start = GC_mmap ((void*)address, h->size);
+      if ((void*)-1 == h->start)
+        h->start = (void*)NULL;
+      unless ((void*)NULL == h->start) {
+        direction = not direction;
+        if (h->size > s->cumulativeStatistics.maxHeapSizeSeen)
+          s->cumulativeStatistics.maxHeapSizeSeen = h->size;
+        if (DEBUG or s->messages)
+          fprintf (stderr, "Created heap of size %zd at "FMTPTR".\n",
+                   /*uintToCommaString*/(h->size),
+                   (uintptr_t)h->start);
+        assert (h->size >= minSize);
+        return TRUE;
+      }
+    }
+    if (s->messages)
+      fprintf(stderr, "[Requested %zuM cannot be satisfied, backing off by %zuM (min size = %zuM).\n",
+              meg (h->size), meg (backoff), meg (minSize));
+  }
+  h->size = 0;
+  return FALSE;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -52,7 +52,7 @@
     assert (s->heap.nursery <= s->frontier);
     assert (s->frontier <= s->limitPlusSlop);
     assert (s->limit == s->limitPlusSlop - LIMIT_SLOP);
-    assert (hasBytesFree (s, 0, 0));
+    assert (heapHasBytesFree (s, 0, 0));
   }
   assert (s->secondaryHeap.start == NULL 
           or s->heap.size == s->secondaryHeap.size);

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,67 @@
+/* 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.
+ */
+
+/* newObject (s, header, bytesRequested, allocInOldGen)
+ *
+ * Allocate a new object in the heap.
+ * bytesRequested includes the size of the header.
+ */
+static pointer newObject (GC_state s,
+                          GC_header header,
+                          size_t bytesRequested,
+                          bool allocInOldGen) {
+  pointer frontier;
+  pointer result;
+
+  assert (isAligned (bytesRequested, s->alignment));
+  assert (allocInOldGen
+          ? heapHasBytesFree (s, bytesRequested, 0)
+          : heapHasBytesFree (s, 0, bytesRequested));
+  if (allocInOldGen) {
+    frontier = s->heap.start + s->heap.oldGenSize;
+    s->heap.oldGenSize += bytesRequested;
+    s->cumulativeStatistics.bytesAllocated += bytesRequested;
+  } else {
+    if (DEBUG_DETAILED)
+      fprintf (stderr, "frontier changed from "FMTPTR" to "FMTPTR"\n",
+               (uintptr_t)s->frontier, 
+               (uintptr_t)(s->frontier + bytesRequested));
+    frontier = s->frontier;
+    s->frontier += bytesRequested;
+  }
+  GC_profileAllocInc (s, bytesRequested);
+  *(GC_header*)(frontier) = header;
+  result = frontier + GC_NORMAL_HEADER_SIZE;
+  if (DEBUG)
+    fprintf (stderr, FMTPTR " = newObject ("FMTHDR", %zd, %s)\n",
+             (uintptr_t)result,
+             header, 
+             bytesRequested,
+             boolToString (allocInOldGen));
+  return result;
+}
+
+static GC_stack newStack (GC_state s, 
+                          size_t reserved, 
+                          bool allocInOldGen) {
+  GC_stack stack;
+
+  reserved = stackReserved (s, reserved);
+  if (reserved > s->cumulativeStatistics.maxStackSizeSeen)
+    s->cumulativeStatistics.maxStackSizeSeen = reserved;
+  stack = (GC_stack) newObject (s, GC_STACK_HEADER, 
+                                stackNumBytes (s, reserved),
+                                allocInOldGen);
+  stack->reserved = reserved;
+  stack->used = 0;
+  if (DEBUG_STACKS)
+    fprintf (stderr, FMTPTR " = newStack (%zd)\n", 
+             (uintptr_t)stack, 
+             reserved);
+  return stack;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -6,21 +6,8 @@
  * See the file MLton-LICENSE for details.
  */
 
-/*
- * Build the header for an object, given the index to its type info.
- */
-static inline GC_header GC_objectHeader (uint32_t t) {
-        assert (t < TWOPOWER (TYPE_INDEX_BITS));
-        return 1 | (t << 1);
-}
 
-#define STACK_HEADER GC_objectHeader (STACK_TYPE_INDEX)
-#define STRING_HEADER GC_objectHeader (STRING_TYPE_INDEX)
-#define THREAD_HEADER GC_objectHeader (THREAD_TYPE_INDEX)
-#define WEAK_GONE_HEADER GC_objectHeader (WEAK_GONE_TYPE_INDEX)
-#define WORD8_VECTOR_HEADER GC_objectHeader (WORD8_TYPE_INDEX)
-
-static char* tagToString (GC_objectTypeTag tag) {
+static char* objectTypeTagToString (GC_objectTypeTag tag) {
   switch (tag) {
   case ARRAY_TAG:
     return "ARRAY";
@@ -35,6 +22,20 @@
   }
 }
 
+/*
+ * Build the header for an object, given the index to its type info.
+ */
+static inline GC_header GC_objectHeader (uint32_t t) {
+        assert (t < TWOPOWER (TYPE_INDEX_BITS));
+        return 1 | (t << 1);
+}
+
+#define GC_STACK_HEADER GC_objectHeader (STACK_TYPE_INDEX)
+#define GC_STRING_HEADER GC_objectHeader (STRING_TYPE_INDEX)
+#define GC_THREAD_HEADER GC_objectHeader (THREAD_TYPE_INDEX)
+#define GC_WEAK_GONE_HEADER GC_objectHeader (WEAK_GONE_TYPE_INDEX)
+#define GC_WORD8_VECTOR_HEADER GC_objectHeader (WORD8_TYPE_INDEX)
+
 static inline void splitHeader(GC_state s, GC_header header,
                                GC_objectTypeTag *tagRet, bool *hasIdentityRet,
                                uint16_t *numNonObjptrsRet, uint16_t *numObjptrsRet) {
@@ -61,7 +62,7 @@
              "  numNonObjptrs = %"PRIu16 
              "  numObjptrs = %"PRIu16"\n", 
              header, 
-             tagToString(tag), hasIdentity, numNonObjptrs, numObjptrs); 
+             objectTypeTagToString(tag), hasIdentity, numNonObjptrs, numObjptrs); 
 
   if (tagRet != NULL)
     *tagRet = tag;
@@ -73,6 +74,20 @@
     *numObjptrsRet = numObjptrs;
 }
 
+static inline size_t numNonObjptrsToBytes (uint16_t numNonObjptrs, 
+                                           GC_objectTypeTag tag) {
+  switch (tag) {
+  case ARRAY_TAG:
+    return (size_t)(numNonObjptrs);
+  case NORMAL_TAG:
+    return (size_t)(numNonObjptrs) * 4;
+  case WEAK_TAG:
+    return (size_t)(numNonObjptrs) * 4;
+  default:
+    die ("bad tag %u", tag);
+  }
+}
+
 /* objectData (s, p)
  *
  * If p points at the beginning of an object, then objectData returns
@@ -93,17 +108,3 @@
   assert (isAligned ((uintptr_t)res, s->alignment));
   return res;
 }
-
-static inline size_t numNonObjptrsToBytes (uint16_t numNonObjptrs, 
-                                           GC_objectTypeTag tag) {
-  switch (tag) {
-  case ARRAY_TAG:
-    return (size_t)(numNonObjptrs);
-  case NORMAL_TAG:
-    return (size_t)(numNonObjptrs) * 4;
-  case WEAK_TAG:
-    return (size_t)(numNonObjptrs) * 4;
-  default:
-    die ("bad tag %u", tag);
-  }
-}

Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,36 @@
+/* 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.
+ */
+
+static inline size_t objectSize (GC_state s, pointer p) {
+  size_t headerBytes, objectBytes;
+  GC_header header;
+  GC_objectTypeTag tag;
+  uint16_t numNonObjptrs, numObjptrs;
+  
+  header = getHeader (p);
+  splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+  if (NORMAL_TAG == tag) { /* Fixed size object. */
+    headerBytes = GC_NORMAL_HEADER_SIZE;
+    objectBytes = 
+      numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+      + (numObjptrs * OBJPTR_SIZE);
+  } else if (ARRAY_TAG == tag) {
+    headerBytes = GC_ARRAY_HEADER_SIZE;
+    objectBytes = arrayNumBytes (s, p, numNonObjptrs, numObjptrs);
+  } else if (WEAK_TAG == tag) {
+    headerBytes = GC_NORMAL_HEADER_SIZE;
+    objectBytes = 
+      numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+      + (numObjptrs * OBJPTR_SIZE);
+  } else { /* Stack. */
+    assert (STACK_TAG == tag);
+    headerBytes = GC_STACK_HEADER_SIZE;
+    objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
+  }
+  return headerBytes + objectBytes;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -11,16 +11,3 @@
   uintptr_t mask = ~((~((uintptr_t)0)) << GC_MODEL_MINALIGN_SHIFT);
   return (0 == ((uintptr_t)p & mask));
 }
-
-static inline void GC_memcpy (pointer src, pointer dst, size_t size) {
-  if (DEBUG_DETAILED)
-    fprintf (stderr, "GC_memcpy ("FMTPTR", "FMTPTR", %zu)\n",
-             (uintptr_t)src, (uintptr_t)dst, size);
-  assert (isAligned ((uintptr_t)src, sizeof(unsigned int)));
-  assert (isAligned ((uintptr_t)dst, sizeof(unsigned int)));
-  assert (isAligned (size, sizeof(unsigned int)));
-  assert (dst <= src or src + size <= dst);
-  if (src == dst)
-    return;
-  memcpy (dst, src, size);
-}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h	2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h	2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,23 @@
+/* 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_profileAllocInc (GC_state s, size_t bytes);
+
+void GC_profileDone (GC_state s);
+
+void GC_profileEnter (GC_state s);
+
+// void GC_profileFree (GC_state s, GC_profile p);
+
+void GC_profileInc (GC_state s, size_t bytes);
+
+void GC_profileLeave (GC_state s);
+
+// GC_profile GC_profileNew (GC_state s);
+
+// void GC_profileWrite (GC_state s, GC_profile p, int fd);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -93,6 +93,21 @@
   return stack->used + stackSlop (s) - topFrameSize(s, stack);
 }
 
+static inline void stackCopy (GC_state s, GC_stack from, GC_stack to) {
+  pointer fromBottom, toBottom;
+
+  fromBottom = stackBottom (s, from);
+  toBottom = stackBottom (s, to);
+  assert (from->used <= to->reserved);
+  to->used = from->used;
+  if (DEBUG_STACKS)
+    fprintf (stderr, "stackCopy from "FMTPTR" to "FMTPTR" of length %zd\n",
+             (uintptr_t) fromBottom, 
+             (uintptr_t) toBottom,
+             from->used);
+  memcpy (fromBottom, toBottom, from->used);
+}
+
 void displayStack (__attribute__ ((unused)) GC_state s,
                    GC_stack stack, 
                    FILE *stream) {

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/platform.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.c	2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,10 @@
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+char* boolToString (bool b) {
+        return b ? "TRUE" : "FALSE";
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c	2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,20 @@
+/* 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.
+ */
+
+static inline void GC_memcpy (pointer src, pointer dst, size_t size) {
+  if (DEBUG_DETAILED)
+    fprintf (stderr, "GC_memcpy ("FMTPTR", "FMTPTR", %zu)\n",
+             (uintptr_t)src, (uintptr_t)dst, size);
+  assert (isAligned ((uintptr_t)src, sizeof(unsigned int)));
+  assert (isAligned ((uintptr_t)dst, sizeof(unsigned int)));
+  assert (isAligned (size, sizeof(unsigned int)));
+  assert (dst <= src or src + size <= dst);
+  if (src == dst)
+    return;
+  memcpy (dst, src, size);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h	2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h	2005-10-09 19:59:19 UTC (rev 4099)
@@ -8,6 +8,6 @@
 
 void *GC_mmapAnon (size_t length);
 void *GC_mmap (void *start, size_t length);
-void *GC_munmap (void *base, size_t length);
+void GC_munmap (void *start, size_t length);
 void GC_release (void *base, size_t length);
 void GC_decommit (void *base, size_t length);