[MLton-commit] r4166

Matthew Fluet MLton@mlton.org
Sun, 6 Nov 2005 18:31:32 -0800


Working on reintegration of gc
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/getcwd.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/readlink.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/setgroups.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Process/exece.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Process/execp.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c
D   mlton/branches/on-20050822-x86_64-branch/runtime/assert.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/Array/numElements.c
D   mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Array.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Vector.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/rusage.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/PackReal.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/basis/Stdio.c
D   mlton/branches/on-20050822-x86_64-branch/runtime/basis/Thread.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h
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
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state_exports.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state_exports.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_suffix.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/model_predicates.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_predicates.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.h
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer_predicates.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.h
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.h
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
D   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/switch-thread.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/platform.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/types.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/Makefile
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/align.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/assert.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/assert.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/die.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/die.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/endian.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/pointer.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/read_write.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/safe.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/to-string.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/util/to-string.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/util.h

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile	2005-11-07 02:30:53 UTC (rev 4166)
@@ -11,7 +11,8 @@
 TARGET = self
 TARGET_ARCH = $(shell ../bin/host-arch)
 TARGET_OS = $(shell ../bin/host-os)
-GCC_VERSION = $(shell gcc -v 2>&1 | grep 'gcc version' | sed 's/.*gcc version \(.\).*/\1/')
+GCC_VERSION = 							\
+	$(shell gcc -v 2>&1 | grep 'gcc version' | sed 's/.*gcc version \(.\).*/\1/')
 
 FLAGS = -fomit-frame-pointer
 
@@ -47,17 +48,40 @@
 CC = gcc -std=gnu99
 CFLAGS = -O2 -Wall -I. -Iplatform -D_FILE_OFFSET_BITS=64 $(FLAGS)
 DEBUGFLAGS = $(CFLAGS) -gstabs+ -g2
+WARNFLAGS = -pedantic -Wall -Wextra -Wno-unused-parameter -Wno-unused-function \
+	-Wformat-nonliteral \
+	-Wuninitialized -Winit-self \
+	-Wstrict-aliasing=2 \
+	-Wfloat-equal \
+	-Wpointer-arith \
+	-Wbad-function-cast -Wcast-qual -Wcast-align \
+	-Waggregate-return \
+	-Wstrict-prototypes \
+	-Wmissing-noreturn -Wmissing-format-attribute \
+	-Wpacked \
+	-Wredundant-decls \
+	-Wnested-externs 
+#	-Wshadow \
+#	-Wconversion \
+#	-Wmissing-prototypes \
+#	-Wmissing-declarations \
+#	-Winline -Wdisabled-optimization
+DEBUGWARNFLAGS = $(DEBUGFLAGS) $(WARNFLAGS) -Wunused
 
 CFILES = 							\
+	$(shell find util -type f | grep '\.c$$')		\
 	$(shell find basis -type f | grep '\.c$$' | grep -v Real/)	\
 	$(shell find Posix -type f | grep '\.c$$')		\
 	gc.c							\
 	platform.c
 
-HFILES = 				\
-	gc.h				\
-	types.h				\
-	platform.h			\
+HFILES = 							\
+	util.h							\
+	$(shell find util -type f | grep '\.h$$')		\
+	gc.h							\
+	$(shell find gc -type f | grep '\.h$$')			\
+	types.h							\
+	platform.h						\
 	platform/$(TARGET_OS).h
 
 FILES = $(basename $(CFILES))
@@ -119,6 +143,18 @@
 runtime.c: $(CFILES)
 	cat $(CFILES) >runtime.c
 
+gc.o: gc.c $(shell find gc -type f | grep '\.c$$') $(HFILES) 
+	$(CC) $(CFLAGS) $(WARNFLAGS) -c -o $@ $<
+
+gc-gdb.o: gc.c $(shell find gc -type f | grep '\.c$$') $(HFILES) 
+	$(CC) $(DEBUGFLAGS) $(DEBUGWARNFLAGS) -O1 -DASSERT=1 -c -o $@ $<
+
+util/%.o: util/%.c $(HFILES)
+	$(CC) $(CFLAGS) $(WARNFLAGS) -c -o $@ $<
+
+util/%-gdb.o: util/%.c $(HFILES)
+	$(CC) $(DEBUGFLAGS) $(DEBUGWARNFLAGS) -O1 -DASSERT=1 -c -o $@ $<
+
 # It looks like we don't follow the C spec w.r.t. aliasing.  And gcc
 # -O2 catches us on the code in Real/*.c where we treat a double as a
 # chunk of two words.  Files that have been known to cause problems

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/getcwd.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/getcwd.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/getcwd.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Cstring Posix_FileSys_getcwd (Pointer buf, Size n) {
-        return (Cstring)(getcwd (buf, n));
+        return (Cstring)(getcwd ((char*)buf, n));
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/readlink.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/readlink.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/readlink.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_readlink (NullString p, Pointer b, Int n) {
-        return readlink ((char *) p, b, n);
+        return readlink ((char*)p, (char*)b, n);
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/setgroups.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/setgroups.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/setgroups.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,9 +6,9 @@
         int res;
         int size;
 
-        size = GC_arrayNumElements (groups);
-        ARRAY (gid_t*, list, size);
-        assert (size <= cardof (list));
+        size = GC_getArrayLength (groups);
+        list = (gid_t*)(calloc_safe (size, sizeof(*list)));
+        assert (size <= (sizeof(list) / sizeof(*list)));
         for (i = 0; i < size; ++i)
                 list[i] = ((Word*)groups)[i];
         res = setgroups (size, list);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Process/exece.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Process/exece.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Process/exece.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -13,9 +13,9 @@
         path = (char *) p;
         args = (char **) a;
         env = (char **) e;
-        an = GC_arrayNumElements (a) - 1;
+        an = GC_getArrayLength (a) - 1;
         asaved = args[an];
-        en = GC_arrayNumElements (e) - 1;
+        en = GC_getArrayLength (e) - 1;
         esaved = env[en];
         args[an] = (char *) NULL;
         env[en] = (char *) NULL;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Process/execp.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Process/execp.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Process/execp.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -9,7 +9,7 @@
 
         file = (char *) f;
         args = (char **) a;
-        n = GC_arrayNumElements (a) - 1;
+        n = GC_getArrayLength (a) - 1;
         saved = args[n];
         args[n] = (char *) NULL;
         result = EXECVP (file, args);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -17,7 +17,7 @@
 Int Posix_Signal_default (Int signum) {
         struct sigaction sa;
 
-        sigdelset (&gcState.signalsHandled, signum);
+        sigdelset (GC_getSignalsHandledAddr (&gcState), signum);
         memset (&sa, 0, sizeof(sa));
         sa.sa_handler = SIG_DFL;
         sa.sa_flags = SA_FLAGS;
@@ -27,7 +27,7 @@
 bool Posix_Signal_isGCPending () {
         Bool res;
 
-        res = gcState.gcSignalIsPending;
+        res = GC_getSignalIsPending (&gcState);
         if (DEBUG_SIGNALS)
                 fprintf (stderr, "%s = Posix_Signal_isGCPending ()\n",
                                 boolToString (res));
@@ -35,13 +35,13 @@
 }
 
 Bool Posix_Signal_isPending (Int signum) {
-        return sigismember (&gcState.signalsPending, signum);
+        return sigismember (GC_getSignalsPendingAddr (&gcState), signum);
 }
 
 Int Posix_Signal_handle (Int signum) {
         static struct sigaction sa;
 
-        sigaddset (&gcState.signalsHandled, signum);
+        sigaddset (GC_getSignalsHandledAddr (&gcState), signum);
         memset (&sa, 0, sizeof(sa));
         /* The mask must be full because GC_handler reads and writes 
          * s->signalsPending  (else there is a race condition).
@@ -53,13 +53,13 @@
 }
 
 void Posix_Signal_handleGC () {
-        gcState.handleGCSignal = TRUE;
+        GC_setGCSignalHandled (&gcState, TRUE);
 }
 
 Int Posix_Signal_ignore (Int signum) {
         struct sigaction sa;
 
-        sigdelset (&gcState.signalsHandled, signum);
+        sigdelset (GC_getSignalsHandledAddr (&gcState), signum);
         memset (&sa, 0, sizeof(sa));
         sa.sa_handler = SIG_IGN;
         sa.sa_flags = SA_FLAGS;
@@ -79,8 +79,8 @@
 void Posix_Signal_resetPending () {
         if (DEBUG_SIGNALS)
                 fprintf (stderr, "Posix_Signal_resetPending ()\n");
-        sigemptyset (&gcState.signalsPending);
-        gcState.gcSignalIsPending = FALSE;
+        sigemptyset (GC_getSignalsPendingAddr (&gcState));
+        GC_setGCSignalPending (&gcState, FALSE);
 }
 
 static sigset_t set;

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/assert.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/assert.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/assert.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,20 +0,0 @@
-/* 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.
- */
-
-#ifndef ASSERT
-#define ASSERT 0
-#endif
-
-/* Assertion failure routine */
-extern void asfail (char *file, int line, char *prop);
-
-/* Assertion verifier */
-#if ASSERT
-#define assert(p) ((p) ? (void)0 : asfail(__FILE__, __LINE__, #p))
-#else
-#define assert(p) ((void)0)
-#endif

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Array/numElements.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Array/numElements.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Array/numElements.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Array_numElements (Pointer p) {
-        return GC_arrayNumElements (p);
+        return GC_getArrayLength (p);
 }

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,29 +0,0 @@
-#define _ISOC99_SOURCE
-
-#include "platform.h"
-
-extern struct GC_state gcState;
-
-void GC_setHashConsDuringGC (Int b) {
-        gcState.hashConsDuringGC = b;
-}
-
-void GC_setMessages (Int b) {
-        gcState.messages = b;
-}
-
-void GC_setSummary (Int b) {
-        gcState.summary = b;
-}
-
-void GC_setRusageMeasureGC (Int b) {
-        gcState.rusageMeasureGC = b;
-}
-
-void MLton_GC_pack () {
-        GC_pack (&gcState);
-}
-
-void MLton_GC_unpack () {
-        GC_unpack (&gcState);
-}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Array.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Array.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -2,11 +2,11 @@
 
 Word32 Word8Array_subWord32Rev (Pointer v, Int offset) {
         Word32 w;
-        char *p;
-        char *s;
+        pointer p;
+        pointer s;
         int i;
 
-        p = (char*)&w;
+        p = (pointer )&w;
         s = v + (offset * 4);
         for (i = 0; i < 4; ++i)
                 p[i] = s[3 - i];
@@ -14,11 +14,11 @@
 }
 
 void Word8Array_updateWord32Rev (Pointer a, Int offset, Word32 w) {
-        char *p;
-        char *s;
+        pointer p;
+        pointer s;
         int i;
 
-        p = (char*)&w;
+        p = (pointer)&w;
         s = a + (offset * 4);
         for (i = 0; i < 4; ++i) {
                 s[i] = p[3 - i];

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Vector.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Vector.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Vector.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -2,11 +2,11 @@
 
 Word32 Word8Vector_subWord32Rev (Pointer v, Int offset) {
         Word32 w;
-        char *p;
-        char *s;
+        pointer p;
+        pointer s;
         int i;
 
-        p = (char*)&w;
+        p = (pointer)&w;
         s = v + (offset * 4);
         for (i = 0; i < 4; ++i)
                 p[i] = s[3 - i];

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,27 +6,17 @@
  * See the file MLton-LICENSE for details.
  */
 
+#define MLTON_GC_INTERNAL
 #include "platform.h"
 
 enum {
-        DEBUG_INT_INF = FALSE,
+  DEBUG_INT_INF = FALSE,
 };
 
 /* Import the global gcState so we can get and set the frontier. */
 extern struct GC_state gcState;
 
 /*
- * Layout of strings.  Note, the value passed around is a pointer to
- * the chars member.
- */
-typedef struct  strng {
-        uint    counter,        /* used by GC. */
-                card,           /* number of chars */
-                magic;          /* STRMAGIC */
-        char    chars[0];       /* actual chars */
-}       strng;
-
-/*
  * Test if a intInf is a fixnum.
  */
 static inline uint isSmall (pointer arg) {
@@ -44,14 +34,14 @@
 /*
  * Convert a bignum intInf to a bignum pointer.
  */
-static inline bignum * toBignum (pointer arg) {
-        bignum  *bp;
+static inline GC_intInf toBignum (pointer arg) {
+        GC_intInf bp;
 
         assert(not isSmall(arg));
-        bp = (bignum *)((uint)arg - offsetof(struct bignum, isneg));
+        bp = (GC_intInf)((uint)arg - offsetof(struct GC_intInf, isneg));
         if (DEBUG_INT_INF)
-                fprintf (stderr, "bp->magic = 0x%08x\n", bp->magic);
-        assert (bp->magic == BIGMAGIC);
+                fprintf (stderr, "bp->header = 0x%08x\n", bp->header);
+        assert (bp->header == GC_INTINF_HEADER);
         return bp;
 }
 
@@ -60,7 +50,7 @@
  * to contain 2 limbs, fill in the __mpz_struct.
  */
 static inline void fill (pointer arg, __mpz_struct *res, mp_limb_t space[2]) {
-        bignum  *bp;
+        GC_intInf bp;
 
         if (DEBUG_INT_INF)
                 fprintf (stderr, "fill (0x%08x, 0x%08x, 0x%08x)\n",
@@ -78,8 +68,8 @@
                         res->_mp_size = 0;
         } else {
                 bp = toBignum(arg);
-                res->_mp_alloc = bp->card - 1;
-                res->_mp_d = bp->limbs;
+                res->_mp_alloc = bp->length - 1;
+                res->_mp_d = (mp_limb_t*)(bp->limbs);
                 res->_mp_size = bp->isneg ? - res->_mp_alloc
                                         : res->_mp_alloc;
         }
@@ -89,16 +79,16 @@
  * Initialize an __mpz_struct to use the space provided by an ML array.
  */
 static inline void initRes (__mpz_struct *mpzp, uint bytes) {
-        struct bignum *bp;
+        GC_intInf bp;
 
         assert (bytes <= gcState.limitPlusSlop - gcState.frontier);
-        bp = (bignum*)gcState.frontier;
+        bp = (GC_intInf)gcState.frontier;
         /* We have as much space for the limbs as there is to the end of the 
          * heap.  Divide by 4 to get number of words. 
          */
         mpzp->_mp_alloc = (gcState.limitPlusSlop - (pointer)bp->limbs) / 4;
         mpzp->_mp_size = 0; /* is this necessary? */
-        mpzp->_mp_d = bp->limbs;
+        mpzp->_mp_d = (mp_limb_t*)(bp->limbs);
 }
 
 /*
@@ -118,7 +108,7 @@
 }
 
 static inline void setFrontier (pointer p, uint bytes) {
-        p = GC_alignFrontier (&gcState, p);
+        p = alignFrontier (&gcState, p);
         assert (p - gcState.frontier <= bytes);
         GC_profileAllocInc (&gcState, p - gcState.frontier);
         gcState.frontier = p;
@@ -134,11 +124,11 @@
  * the array size and roll the frontier slightly back.
  */
 static pointer answer (__mpz_struct *ans, uint bytes) {
-        bignum                  *bp;
+        GC_intInf               bp;
         int                     size;
 
-        bp = (bignum *)((pointer)ans->_mp_d - offsetof(struct bignum, limbs));
-        assert(ans->_mp_d == bp->limbs);
+        bp = (GC_intInf)((pointer)ans->_mp_d - offsetof(struct GC_intInf, limbs));
+        assert(ans->_mp_d == (mp_limb_t*)(bp->limbs));
         size = ans->_mp_size;
         if (size < 0) {
                 bp->isneg = TRUE;
@@ -168,10 +158,10 @@
                         return (pointer)(ans<<1 | 1);
                 }
         }
-        setFrontier ((pointer)&bp->limbs[size], bytes);
+        setFrontier ((pointer)(&bp->limbs[size]), bytes);
         bp->counter = 0;
-        bp->card = size + 1; /* +1 for isNeg word */
-        bp->magic = BIGMAGIC;
+        bp->length = size + 1; /* +1 for isNeg word */
+        bp->header = GC_INTINF_HEADER;
         return (pointer)&bp->isneg;
 }
 
@@ -303,11 +293,11 @@
 Word
 IntInf_smallMul(Word lhs, Word rhs, pointer carry)
 {
-        llong   prod;
+        intmax_t   prod;
 
-        prod = (llong)(int)lhs * (int)rhs;
-        *(uint *)carry = (ullong)prod >> 32;
-        return ((uint)(ullong)prod);
+        prod = (intmax_t)(int)lhs * (int)rhs;
+        *(uint *)carry = (uintmax_t)prod >> 32;
+        return ((uint)(uintmax_t)prod);
 }
 
 /*
@@ -346,7 +336,7 @@
  * string (mutable) which is large enough.
  */
 pointer IntInf_toString (pointer arg, int base, uint bytes) {
-        strng           *sp;
+        GC_string       sp;
         __mpz_struct    argmpz;
         mp_limb_t       argspace[2];
         char            *str;
@@ -359,7 +349,7 @@
                                 (uint)arg, base, bytes);
         assert (base == 2 || base == 8 || base == 10 || base == 16);
         fill (arg, &argmpz, argspace);
-        sp = (strng*)gcState.frontier;
+        sp = (GC_string)gcState.frontier;
         str = mpz_get_str(sp->chars, base, &argmpz);
         assert(str == sp->chars);
         size = strlen(str);
@@ -372,9 +362,9 @@
                                 sp->chars[i] = c + ('A' - 'a');
                 }
         sp->counter = 0;
-        sp->card = size;
-        sp->magic = STRMAGIC;
-        setFrontier (&sp->chars[wordAlign(size)], bytes);
+        sp->length = size;
+        sp->header = GC_STRING_HEADER;
+        setFrontier ((pointer)(&sp->chars[align(size, 4)]), bytes);
         return (pointer)str;
 }
 

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c (from rev 4165, mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,29 @@
+#define _ISOC99_SOURCE
+
+#include "platform.h"
+
+extern struct GC_state gcState;
+
+void MLton_GC_setHashConsDuringGC (Int b) {
+  GC_setHashConsDuringGC (&gcState, b);
+}
+
+void MLton_GC_setMessages (Int b) {
+  GC_setMessages (&gcState, b);
+}
+
+void MLton_GC_setSummary (Int b) {
+  GC_setSummary (&gcState, b);
+}
+
+void MLton_GC_setRusageMeasureGC (Int b) {
+  GC_setRusageMeasureGC (&gcState, b);
+}
+
+void MLton_GC_pack () {
+  GC_pack (&gcState);
+}
+
+void MLton_GC_unpack () {
+  GC_unpack (&gcState);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -7,7 +7,7 @@
 extern struct GC_state gcState;
 
 void MLton_Profile_Data_free (Pointer p) {
-        GC_profileFree (&gcState, (GC_profile)p);
+        GC_profileFree (&gcState, (GC_profileData)p);
 }
 
 Pointer MLton_Profile_Data_malloc (void) {
@@ -17,30 +17,25 @@
 void MLton_Profile_Data_write (Pointer p, Word fd) {
         if (DEBUG_PROFILE)
                 fprintf (stderr, "MLton_Profile_Data_write (0x%08x)\n", (uint)p);
-        GC_profileWrite (&gcState, (GC_profile)p, (int)fd);
+        GC_profileWrite (&gcState, (GC_profileData)p, (int)fd);
 }
 
 Pointer MLton_Profile_current (void) {
-        GC_state s;
         Pointer res;
 
-        s = &gcState;
-        res = (Pointer)s->profile;
+        res = (Pointer)(GC_getProfileCurrent (&gcState));
         if (DEBUG_PROFILE)
                 fprintf (stderr, "0x%08x = MLton_Profile_current ()\n", 
                                 (uint)res);
         return res;
 }
 
-void MLton_Profile_done () {
-        GC_profileDone (&gcState);
-}
-
 void MLton_Profile_setCurrent (Pointer d) {
-        GC_state s;
-
-        s = &gcState;
         if (DEBUG_PROFILE)
                 fprintf (stderr, "MLton_Profile_setCurrent (0x%08x)\n", (uint)d);
-        s->profile = (GC_profile)d;
+        GC_setProfileCurrent (&gcState, (GC_profileData)d);
 }
+
+void MLton_Profile_done () {
+        GC_profileDone (&gcState);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/rusage.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/rusage.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/rusage.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -55,7 +55,7 @@
 }
 
 void MLton_Rusage_ru () {
-        gc = gcState.ru_gc;
-        fixedGetrusage (RUSAGE_SELF, &self);
-        fixedGetrusage (RUSAGE_CHILDREN, &children);
+        gc = *(GC_getRusageGCAddr (&gcState));
+        getrusage (RUSAGE_SELF, &self);
+        getrusage (RUSAGE_CHILDREN, &children);
 }

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/basis/Thread.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Thread.c	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,54 @@
+#include "platform.h"
+
+extern struct GC_state gcState;
+
+enum {
+        DEBUG_THREAD = FALSE,
+};
+
+Thread Thread_current () {
+        Thread t;
+
+        t = (Thread)(GC_getCurrentThread (&gcState));
+        if (DEBUG_THREAD)
+                fprintf (stderr, "0x%08x = Thread_current ()\n", (uint)t);
+        return t;
+}
+
+void Thread_finishHandler () {
+        GC_finishHandler (&gcState);
+}
+
+Thread Thread_saved () {
+        Thread t;
+
+        t = (Thread)(GC_getSavedThread (&gcState));
+        if (DEBUG_THREAD)
+                fprintf (stderr, "0x%08x = Thread_saved ()\n", (uint)t);
+        return t;
+}
+
+void Thread_setCallFromCHandler (Thread t) {
+        GC_setCallFromCHandlerThread (&gcState, (GC_thread)t);
+}
+
+void Thread_setSaved (Thread t) {
+        if (DEBUG_THREAD)
+                fprintf (stderr, "Thread_setSaved (0x%08x)\n", (uint)t);
+        GC_setSavedThread (&gcState, (GC_thread)t);
+}
+
+void Thread_setSignalHandler (Thread t) {
+        GC_setSignalHandlerThread (&gcState, (GC_thread)t);
+}
+
+void Thread_startHandler () {
+        GC_startHandler (&gcState);
+}
+
+void Thread_switchTo (Thread thread, Word ensureBytesFree) {
+        if (DEBUG_THREAD)
+                fprintf (stderr, "Thread_switchTo (0x%08x, %u)\n",
+                                (uint)thread, (uint)ensureBytesFree);
+        GC_switchToThread (&gcState, (GC_thread)thread, ensureBytesFree);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -3,10 +3,9 @@
 extern struct GC_state gcState;
 
 Bool World_isOriginal() {
-        return gcState.isOriginal;
+        return (Bool)(GC_getAmOriginal (&gcState));
 }
 
-
 void World_makeOriginal() {
-        gcState.isOriginal = TRUE;
+        GC_setAmOriginal (&gcState, TRUE);
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -49,5 +49,5 @@
 }
 
 Int NetHostDB_getHostName(Pointer buf, Int len) {
-        return (gethostname (buf, len));
+        return (gethostname ((char*) buf, len));
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/PackReal.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/PackReal.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/PackReal.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -2,8 +2,8 @@
 
 Real32 PackReal32_subVec (Pointer v, Int offset) {
         Real32 r;
-        char *p = (char*)&r;
-        char *s = v + offset;
+        pointer p = (pointer)&r;
+        pointer s = v + offset;
         int i;
 
         for (i = 0; i < 4; ++i)
@@ -13,8 +13,8 @@
 
 Real32 PackReal32_subVecRev (Pointer v, Int offset) {
         Real32 r;
-        char *p = (char*)&r;
-        char *s = v + offset;
+        pointer p = (pointer)&r;
+        pointer s = v + offset;
         int i;
 
         for (i = 0; i < 4; ++i)
@@ -24,8 +24,8 @@
 
 Real64 PackReal64_subVec (Pointer v, Int offset) {
         Real64 r;
-        char *p = (char*)&r;
-        char *s = v + offset;
+        pointer p = (pointer)&r;
+        pointer s = v + offset;
         int i;
 
         for (i = 0; i < 8; ++i)
@@ -35,8 +35,8 @@
 
 Real64 PackReal64_subVecRev (Pointer v, Int offset) {
         Real64 r;
-        char *p = (char*)&r;
-        char *s = v + offset;
+        pointer p = (pointer)&r;
+        pointer s = v + offset;
         int i;
 
         for (i = 0; i < 8; ++i)
@@ -45,8 +45,8 @@
 }
 
 void PackReal32_update (Pointer a, Int offset, Real32 r) {
-        char *p = (char*)&r;
-        char *s = a + offset;
+        pointer p = (pointer)&r;
+        pointer s = a + offset;
         int i;
 
         for (i = 0; i < 4; ++i) {
@@ -55,8 +55,8 @@
 }
 
 void PackReal32_updateRev (Pointer a, Int offset, Real32 r) {
-        char *p = (char*)&r;
-        char *s = a + offset;
+        pointer p = (pointer)&r;
+        pointer s = a + offset;
         int i;
 
         for (i = 0; i < 4; ++i) {
@@ -65,8 +65,8 @@
 }
 
 void PackReal64_update (Pointer a, Int offset, Real64 r) {
-        char *p = (char*)&r;
-        char *s = a + offset;
+        pointer p = (pointer)&r;
+        pointer s = a + offset;
         int i;
 
         for (i = 0; i < 8; ++i) {
@@ -75,8 +75,8 @@
 }
 
 void PackReal64_updateRev (Pointer a, Int offset, Real64 r) {
-        char *p = (char*)&r;
-        char *s = a + offset;
+        pointer p = (pointer)&r;
+        pointer s = a + offset;
         int i;
 
         for (i = 0; i < 8; ++i) {

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Stdio.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Stdio.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Stdio.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -8,5 +8,5 @@
 }
 
 Int Stdio_sprintf (Pointer buf, Pointer fmt, Real x) {
-        return sprintf (buf, (char*) fmt, x);
+        return sprintf ((char*) buf, (char*) fmt, x);
 }

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Thread.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Thread.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,55 +0,0 @@
-#include "platform.h"
-
-extern struct GC_state gcState;
-
-enum {
-        DEBUG_THREAD = FALSE,
-};
-
-Thread Thread_current () {
-        Thread t;
-
-        t = (Thread)gcState.currentThread;
-        if (DEBUG_THREAD)
-                fprintf (stderr, "0x%08x = Thread_current ()\n", (uint)t);
-        return t;
-}
-
-void Thread_finishHandler () {
-        GC_finishHandler (&gcState);
-}
-
-Thread Thread_saved () {
-        Thread t;
-
-        t = (Thread)gcState.savedThread;
-        gcState.savedThread = (GC_thread)0x1;
-        if (DEBUG_THREAD)
-                fprintf (stderr, "0x%08x = Thread_saved ()\n", (uint)t);
-        return t;
-}
-
-void Thread_setCallFromCHandler (Thread t) {
-        gcState.callFromCHandler = (GC_thread)t;
-}
-
-void Thread_setSaved (Thread t) {
-        if (DEBUG_THREAD)
-                fprintf (stderr, "Thread_setSaved (0x%08x)\n", (uint)t);
-        gcState.savedThread = (GC_thread)t;
-}
-
-void Thread_setHandler (Thread t) {
-        gcState.signalHandler = (GC_thread)t;
-}
-
-void Thread_startHandler () {
-        GC_startHandler (&gcState);
-}
-
-void Thread_switchTo (Thread thread, Word ensureBytesFree) {
-        if (DEBUG_THREAD)
-                fprintf (stderr, "Thread_switchTo (0x%08x, %u)\n",
-                                (uint)thread, (uint)ensureBytesFree);
-        GC_switchToThread (&gcState, (GC_thread)thread, ensureBytesFree);
-}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h (from rev 4165, mlton/branches/on-20050822-x86_64-branch/runtime/platform.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,50 @@
+/* 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.
+ */
+
+#ifndef _MLTON_CENV_H_
+#define _MLTON_CENV_H_
+
+#define _ISOC99_SOURCE
+#define _BSD_SOURCE
+
+/* Only enable _POSIX_C_SOURCE on platforms that don't have broken system
+ * headers.
+ */
+#if (defined (__linux__))
+#define _POSIX_C_SOURCE 200112L
+#endif
+
+/* C99-specific headers */
+#include <stddef.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <iso646.h>
+#include <stdint.h>
+#include <inttypes.h>
+#include <limits.h>
+#include <string.h>
+#include <stdio.h>
+#include <math.h>
+
+#include <errno.h>
+#include <fcntl.h>
+#include <unistd.h>
+
+#include <dirent.h>
+#include <signal.h>
+#include <time.h>
+#include <utime.h>
+#include <sys/resource.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+
+
+#include "gmp.h"
+
+#endif /* _MLTON_CENV_H_ */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,219 +6,8 @@
  # See the file MLton-LICENSE for details.
  ##
 
-PATH = ../../bin:$(shell echo $$PATH)
+all:
 
-TARGET = self
-TARGET_ARCH = $(shell ../../bin/host-arch)
-TARGET_OS = $(shell ../../bin/host-os)
-GCC_VERSION = $(shell gcc -v 2>&1 | grep 'gcc version' | sed 's/.*gcc version \(.\).*/\1/')
-
-FLAGS = -fomit-frame-pointer
-
-ifeq ($(TARGET_ARCH), x86)
-ifneq ($(findstring $(GCC_VERSION), 3 4),)
-FLAGS += -falign-loops=2 -falign-jumps=2 -falign-functions=5
-else
-FLAGS += -malign-loops=2 -malign-jumps=2 -malign-functions=5
-endif
-DEFAULT_MODEL = A
-ALL_MODELS = A
-endif
-
-ifeq ($(TARGET_ARCH), amd64)
-FLAGS += -mtune=opteron
-DEFAULT_MODEL = BX
-ALL_MODELS = A AX B BX C CX G
-endif
-
-ifeq ($(TARGET_ARCH), sparc)
-FLAGS += -mv8 -m32
-endif
-
-ifeq ($(TARGET_OS), solaris)
-FLAGS += -Wa,-xarch=v8plusa -fcall-used-g5 -fcall-used-g7 -funroll-all-loops -mcpu=ultrasparc
-endif
-
-ifeq ($(TARGET), self)
-AR = ar rc
-RANLIB = ranlib
-else
-AR = $(TARGET)-ar rc
-RANLIB = $(TARGET)-ranlib
-FLAGS += -b $(TARGET)
-endif
-
-CC = gcc -std=gnu99
-CWFLAGS = -pedantic -Wall -Wextra -Wno-unused-parameter -Wno-unused-function \
-	-Wformat-nonliteral \
-	-Wuninitialized -Winit-self \
-	-Wstrict-aliasing=2 \
-	-Wfloat-equal \
-	-Wpointer-arith \
-	-Wbad-function-cast -Wcast-qual -Wcast-align \
-	-Waggregate-return \
-	-Wstrict-prototypes \
-	-Wmissing-noreturn -Wmissing-format-attribute \
-	-Wpacked \
-	-Wredundant-decls \
-	-Wnested-externs 
-#	-Wshadow \
-#	-Wconversion \
-#	-Wmissing-prototypes \
-#	-Wmissing-declarations \
-#	-Winline -Wdisabled-optimization
-CFLAGS = -O2 $(CWFLAGS) -I. -D_FILE_OFFSET_BITS=64 $(FLAGS)
-DEBUGFLAGS = $(CFLAGS) -Wunused -gstabs+ -g2
-
-## Order matters, as these are concatenated together to form "libgc.c".
-CFILES = 								\
-	gc_prefix.c							\
-	util.c								\
-	safe.c								\
-	read_write.c							\
-	rusage.c							\
-	debug.c								\
-	align.c								\
-	virtual-memory.c						\
-	array-allocate.c						\
-	array.c								\
-	atomic.c							\
-	call-stack.c							\
-	cheney-copy.c							\
-	controls.c							\
-	copy-thread.c							\
-	current.c   							\
-	dfs-mark.c							\
-	done.c								\
-	enter_leave.c							\
-	foreach.c							\
-	forward.c							\
-	frame.c								\
-	garbage-collection.c						\
-	gc_state.c   							\
-	generational.c							\
-	handler.c							\
-	hash-cons.c							\
-	heap.c								\
-	heap_predicates.c						\
-	init-world.c							\
-	init.c								\
-	invariant.c   							\
-	mark-compact.c							\
-	model.c								\
-	model_predicates.c						\
-	new-object.c   							\
-	object-size.c							\
-	object.c							\
-	object_predicates.c						\
-	pack.c								\
-	pointer.c							\
-	pointer_predicates.c						\
-	profiling.c							\
-	share.c								\
-	signals.c							\
-	size.c								\
-	sources.c							\
-	stack.c								\
-	stack_predicates.c						\
-	switch-thread.c							\
-	thread.c							\
-	translate.c							\
-	weak.c								\
-	world.c								\
-	assumptions.c							\
-	gc_suffix.c
-
-## Order matters, as these are concatenated together to form "libgc.h".
-HFILES = 								\
-	gc_prefix.h							\
-	util.h								\
-	safe.h								\
-	rusage.h							\
-	virtual-memory.h						\
-	model.h								\
-	pointer.h							\
-	objptr.h							\
-	object.h							\
-	array.h								\
-	frame.h								\
-	stack.h								\
-	thread.h							\
-	weak.h								\
-	int-inf.h							\
-	object-size.h							\
-	generational.h							\
-	heap.h								\
-	current.h							\
-	foreach.h							\
-	translate.h							\
-	sysvals.h							\
-	controls.h							\
-	major.h								\
-	statistics.h							\
-	forward.h							\
-	cheney-copy.h							\
-	hash-cons.h							\
-	dfs-mark.h							\
-	mark-compact.h							\
-	invariant.h							\
-	atomic.h							\
-	enter_leave.h							\
-	signals.h							\
-	handler.h							\
-	switch-thread.h							\
-	garbage-collection.h						\
-	new-object.h							\
-	array-allocate.h						\
-	sources.h							\
-	call-stack.h							\
-	profiling.h							\
-	init-world.h							\
-	world.h								\
-	init.h								\
-	done.h								\
-	copy-thread.h							\
-	pack.h								\
-	share.h								\
-	size.h								\
-	gc_state.h							\
-	gc_suffix.h
-
-all: libgc.o libgc-gdb.o
-
-libgc-gdb.o: libgc.c libgc.h
-	$(CC) $(DEBUGFLAGS) -DGC_MODEL_$(DEFAULT_MODEL) -O1 -DASSERT=1 -c -o $@ libgc.c
-
-libgc.o: libgc.c libgc.h
-	$(CC) $(CFLAGS) -DGC_MODEL_$(DEFAULT_MODEL) -c -o $@ libgc.c
-
-libgc.c: $(CFILES)
-	rm -f libgc.c
-	(								\
-		for f in $(CFILES); do					\
-			echo "#line 1 \"$$f\"";				\
-			cat $$f;					\
-		done;							\
-	) > libgc.c
-
-libgc.h: $(HFILES)
-	rm -f libgc.h
-	(								\
-		for f in $(HFILES); do					\
-			echo "#line 1 \"$$f\"";				\
-			cat $$f;					\
-		done;							\
-	) > libgc.h
-
-.PHONY: models
-models: libgc.c libgc.h
-	(								\
-		for m in $(ALL_MODELS); do				\
-			$(CC) $(CFLAGS) -DGC_MODEL_$$m -c -o libgc.$$m.o libgc.c;	\
-			$(CC) $(DEBUGFLAGS) -O1 -DASSERT=1 -DGC_MODEL_$$m -c -o libgc-gdb.$$m.o libgc.c;	\
-		done;							\
-	)
-
-.PHONY: clean
+.PHONY:
 clean:
 	../../bin/clean

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,49 +0,0 @@
-/* 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 bool isAligned (size_t a, size_t b) {
-  return 0 == a % b;
-}
-
-static inline bool isAlignedMax (uintmax_t a, uintmax_t b) {
-  return 0 == a % b;
-}
-
-static inline size_t alignDown (size_t a, size_t b) {
-  assert (b >= 1);
-  a -= a % b;
-  assert (isAligned (a, b));
-  return a;
-}
-
-static inline uintmax_t alignMaxDown (uintmax_t a, uintmax_t b) {
-  assert (b >= 1);
-  a -= a % b;
-  assert (isAlignedMax (a, b));
-  return a;
-}
-
-static inline size_t align (size_t a, size_t b) {
-  assert (b >= 1);
-  a += b - 1;
-  a -= a % b;
-  assert (isAligned (a, b));
-  return a;       
-}
-
-static inline uintmax_t alignMax (uintmax_t a, uintmax_t b) {
-  assert (b >= 1);
-  a += b - 1;
-  a -= a % b;
-  assert (isAligned (a, b));
-  return a;       
-}
-
-static inline size_t pad (GC_state s, size_t bytes, size_t extra) {
-  return align (bytes + extra, s->alignment) - extra;
-}

Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,27 @@
+/* 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 pad (GC_state s, size_t bytes, size_t extra) {
+  return align (bytes + extra, s->alignment) - extra;
+}
+
+
+#if ASSERT
+bool isFrontierAligned (GC_state s, pointer p) {
+  return isAligned ((size_t)p + GC_NORMAL_HEADER_SIZE, 
+                    s->alignment);
+}
+#endif
+
+pointer alignFrontier (GC_state s, pointer p) {
+  size_t res;
+
+  res = pad (s, (size_t)p, GC_NORMAL_HEADER_SIZE);
+  assert (isFrontierAligned (s, (pointer)res));
+  return (pointer)res;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -66,3 +66,8 @@
     + nonObjptrBytesPerElement
     + pointerIndex * OBJPTR_SIZE;
 }
+
+
+GC_arrayLength GC_getArrayLength (pointer a) {
+  return getArrayLength (a);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -64,7 +64,7 @@
        &s->cumulativeStatistics.ru_gcMinor, 
        s->cumulativeStatistics.numMinorGCs, 
        s->cumulativeStatistics.bytesCopiedMinor);
-    time = currentTime () - s->startTime;
+    time = getCurrentTime () - s->startTime;
     fprintf (out, "total GC time: %s ms (%.1f%%)\n",
              uintmaxToCommaString (gcTime), 
              (0 == time) 

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,9 +0,0 @@
-/* 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_done (GC_state s);

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-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,5 +1,2 @@
 #include "libgc.h"
 
-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-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,6 +6,7 @@
  * See the file MLton-LICENSE for details.
  */
 
+#ifdef MLTON_GC_INTERNAL
 struct GC_state {
   size_t alignment; /* */
   bool amInGC;
@@ -60,6 +61,7 @@
   uint32_t vectorInitsLength;
   GC_weak weaks; /* Linked list of (live) weak pointers */
 };
+#endif
 
 void displayGCState (GC_state s, FILE *stream);
 

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state_exports.c (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state_exports.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,80 @@
+/* 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.
+ */
+
+bool GC_getAmOriginal (GC_state s) {
+  return s->amOriginal;
+}
+void GC_setAmOriginal (GC_state s, bool b) {
+  s->amOriginal = b;
+}
+
+void GC_setMessages (GC_state s, bool b) {
+  s->controls.messages = b;
+}
+
+void GC_setSummary (GC_state s, bool b) {
+  s->controls.summary = b;
+}
+
+void GC_setRusageMeasureGC (GC_state s, bool b) {
+  s->controls.rusageMeasureGC = b;
+}
+
+void GC_setHashConsDuringGC (GC_state s, bool b) {
+  s->hashConsDuringGC = b;
+}
+
+struct rusage* GC_getRusageGCAddr (GC_state s) {
+  return &(s->cumulativeStatistics.ru_gc);
+}
+
+sigset_t* GC_getSignalsHandledAddr (GC_state s) {
+  return &(s->signalsInfo.signalsHandled);
+}
+
+bool GC_getSignalIsPending (GC_state s) {
+  return (s->signalsInfo.signalIsPending);
+}
+
+sigset_t* GC_getSignalsPendingAddr (GC_state s) {
+  return &(s->signalsInfo.signalsPending);
+}
+
+void GC_setGCSignalHandled (GC_state s, bool b) {
+  s->signalsInfo.gcSignalHandled = b;
+}
+
+void GC_setGCSignalPending (GC_state s, bool b) {
+  s->signalsInfo.gcSignalPending = b;
+}
+
+void GC_setCallFromCHandlerThread (GC_state s, GC_thread t) {
+  objptr op = pointerToObjptr ((pointer)t, s->heap.start);
+  s->callFromCHandlerThread = op;
+}
+
+GC_thread GC_getCurrentThread (GC_state s) {
+  pointer p = objptrToPointer (s->currentThread, s->heap.start);
+  return (GC_thread)p;
+}
+
+GC_thread GC_getSavedThread (GC_state s) {
+  pointer p = objptrToPointer (s->savedThread, s->heap.start);
+  s->savedThread = BOGUS_OBJPTR;
+  return (GC_thread)p;
+}
+
+void GC_setSavedThread (GC_state s, GC_thread t) {
+  objptr op = pointerToObjptr ((pointer)t, s->heap.start);
+  s->savedThread = op;
+}
+
+void GC_setSignalHandlerThread (GC_state s, GC_thread t) {
+  objptr op = pointerToObjptr ((pointer)t, s->heap.start);
+  s->signalHandlerThread = op;
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state_exports.h (from rev 4164, 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-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state_exports.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,28 @@
+/* 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.
+ */
+
+bool GC_getAmOriginal (GC_state s);
+void GC_setAmOriginal (GC_state s, bool b);
+void GC_setMessages (GC_state s, bool b);
+void GC_setSummary (GC_state s, bool b);
+void GC_setRusageMeasureGC (GC_state s, bool b);
+void GC_setHashConsDuringGC (GC_state s, bool b);
+struct rusage* GC_getRusageGCAddr (GC_state s);
+
+GC_thread GC_getCurrentThread (GC_state s);
+GC_thread GC_getSavedThread (GC_state s);
+void GC_setCallFromCHandlerThread (GC_state s, GC_thread thread);
+void GC_setSavedThread (GC_state s, GC_thread thread);
+void GC_setSignalHandlerThread (GC_state s, GC_thread thread);
+
+sigset_t* GC_getSignalsHandledAddr (GC_state s);
+bool GC_getSignalIsPending (GC_state s);
+sigset_t* GC_getSignalsPendingAddr (GC_state s);
+void GC_setGCSignalHandled (GC_state s, bool b);
+void GC_setGCSignalPending (GC_state s, bool b);
+

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_suffix.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_suffix.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_suffix.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1 +0,0 @@
-#endif /* _MLTON_GC_H_ */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,7 +6,4 @@
  * See the file MLton-LICENSE for details.
  */
 
-void GC_startHandler (GC_state s);
-void GC_finishHandler (GC_state s);
 void switchToHandlerThreadIfNonAtomicAndSignalPending (GC_state s);
-void GC_handler (GC_state s, int signum);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -198,9 +198,11 @@
     }
     if (s->controls.messages)
       fprintf(stderr, 
-              "[Requested %zuM cannot be satisfied, "
-              "backing off by %zuM (min size = %zuM).\n",
-              meg (h->size), meg (backoff), meg (minSize));
+              "[Requested %s cannot be satisfied, "
+              "backing off by %s (min size = %s).\n",
+              sizeToBytesApproxString (h->size),
+              sizeToBytesApproxString (backoff), 
+              sizeToBytesApproxString (minSize));
   }
   h->size = 0;
   return FALSE;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,6 +6,9 @@
  * See the file MLton-LICENSE for details.
  */
 
+/* Layout of intInfs.  
+ * Note, the value passed around is a pointer to the isneg member.
+ */
 typedef struct GC_intInf {
   GC_arrayCounter counter;
   GC_arrayLength length;
@@ -13,3 +16,5 @@
   uint32_t isneg;
   uint32_t *limbs;
 } *GC_intInf;
+
+#define GC_INTINF_HEADER GC_WORD32_VECTOR_HEADER

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -65,7 +65,7 @@
   foreachObjptrInRange (s, s->heap.nursery, &s->frontier, 
                         assertIsObjptrInFromSpace, FALSE);
   /* Current thread. */
-  GC_stack stack = getStackCurrent(s);
+  __attribute__ ((unused)) GC_stack stack = getStackCurrent(s);
   assert (isStackReservedAligned (s, stack->reserved));
   assert (s->stackBottom == getStackBottom (s, stack));
   assert (s->stackTop == getStackTop (s, stack));

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -10,19 +10,35 @@
 /*                 Jonkers Mark-compact Collection                  */
 /* ---------------------------------------------------------------- */
 
-/* An object pointer might be larger than a header.
- */ 
 void copyForThreadInternal (pointer dst, pointer src) {
-  size_t count;
 
-  assert (0 == (OBJPTR_SIZE % GC_HEADER_SIZE));
-  count = (OBJPTR_SIZE - GC_HEADER_SIZE) / GC_HEADER_SIZE;
-  src = src + GC_HEADER_SIZE * count;
+  if (OBJPTR_SIZE > GC_HEADER_SIZE) {
+    size_t count;
 
-  for (size_t i = 0; i <= count; i++) {
+    assert (0 == (OBJPTR_SIZE % GC_HEADER_SIZE));
+    count = (OBJPTR_SIZE - GC_HEADER_SIZE) / GC_HEADER_SIZE;
+    src = src + GC_HEADER_SIZE * count;
+    
+    for (size_t i = 0; i <= count; i++) {
+      *((GC_header*)dst) = *((GC_header*)src);
+      dst += GC_HEADER_SIZE;
+      src -= GC_HEADER_SIZE;
+    }
+  } else if (GC_HEADER_SIZE > OBJPTR_SIZE) {
+    size_t count;
+
+    assert (0 == (GC_HEADER_SIZE % OBJPTR_SIZE));
+    count = (GC_HEADER_SIZE - OBJPTR_SIZE) / OBJPTR_SIZE;
+    dst = dst + OBJPTR_SIZE * count;
+    
+    for (size_t i = 0; i <= count; i++) {
+      *((objptr*)dst) = *((objptr*)src);
+      dst -= OBJPTR_SIZE;
+      src += OBJPTR_SIZE;
+    }
+
+  } else /* (GC_HEADER_SIZE == OBJPTR_SIZE) */ {
     *((GC_header*)dst) = *((GC_header*)src);
-    dst += GC_HEADER_SIZE;
-    src -= GC_HEADER_SIZE;
   }
 }
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -135,7 +135,9 @@
 manageable set for users.
 */
 
-#if (defined (GC_MODEL_A))
+#if (defined (MLTON_GC_INTERNAL))
+
+#if (defined (GC_MODEL_A) || defined (GC_MODEL_NATIVE32))
 #define GC_MODEL_BITSIZE  32
 #define GC_MODEL_SHIFT    0
 #define GC_MODEL_USEBASE  FALSE
@@ -195,7 +197,7 @@
 #define GC_MODEL_SHIFT    0
 #define GC_MODEL_USEBASE  TRUE
 #define GC_MODEL_MINALIGN_SHIFT 2
-#elif (defined (GC_MODEL_G))
+#elif (defined (GC_MODEL_G) || defined (GC_MODEL_NATIVE64))
 #define GC_MODEL_BITSIZE  64
 #define GC_MODEL_SHIFT    0
 #define GC_MODEL_USEBASE  FALSE
@@ -205,3 +207,5 @@
 #endif
 #define GC_MODEL_NONOBJPTR ((GC_MODEL_MINALIGN_SHIFT - GC_MODEL_SHIFT) > 0)
 #define GC_MODEL_MINALIGN TWOPOWER(GC_MODEL_MINALIGN_SHIFT)
+
+#endif /* (defined (MLTON_GC_INTERNAL)) */

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/model_predicates.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/model_predicates.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/model_predicates.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,18 +0,0 @@
-/* Copyright (C) 2005-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.
- */
-
-/* isObjptr returns true if p looks like an object pointer. */
-bool isObjptr (objptr p) {
-  if GC_MODEL_NONOBJPTR {
-    unsigned int shift = GC_MODEL_MINALIGN_SHIFT - GC_MODEL_SHIFT;
-    objptr mask = ~((~((objptr)0)) << shift);
-    return (0 == (p & mask));
-  } else {
-    return TRUE;
-  }
-}
-

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -86,17 +86,6 @@
     *numObjptrsRet = numObjptrs;
 }
 
-pointer alignFrontier (GC_state s, pointer p) {
-  size_t res;
-
-  res = pad (s, (size_t)p, GC_NORMAL_HEADER_SIZE);
-  if (DEBUG_STACKS)
-    fprintf (stderr, FMTPTR" = alignFrontier ("FMTPTR")\n", 
-             (uintptr_t)p, (uintptr_t)res);
-  assert (isFrontierAligned (s, (pointer)res));
-  return (pointer)res;
-}
-
 /* advanceToObjectData (s, p)
  *
  * If p points at the beginning of an object, then advanceToObjectData

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -122,7 +122,6 @@
                   uint16_t *numNonObjptrsRet, uint16_t *numObjptrsRet);
 
 bool isFrontierAligned (GC_state s, pointer p);
-pointer alignFrontier (GC_state s, pointer p);
 
 pointer advanceToObjectData (GC_state s, pointer p);
 

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_predicates.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_predicates.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_predicates.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,15 +0,0 @@
-/* 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
-bool isFrontierAligned (GC_state s, pointer p) {
-  return isAligned ((size_t)p + GC_NORMAL_HEADER_SIZE, 
-                    s->alignment);
-}
-#endif
-

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -5,6 +5,17 @@
  * See the file MLton-LICENSE for details.
  */
 
+/* isObjptr returns true if p looks like an object pointer. */
+bool isObjptr (objptr p) {
+  if GC_MODEL_NONOBJPTR {
+    unsigned int shift = GC_MODEL_MINALIGN_SHIFT - GC_MODEL_SHIFT;
+    objptr mask = ~((~((objptr)0)) << shift);
+    return (0 == (p & mask));
+  } else {
+    return TRUE;
+  }
+}
+
 pointer objptrToPointer (objptr O, pointer B) {
   uintptr_t O_ = (uintptr_t)O;
   uintptr_t B_;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -5,6 +5,8 @@
  * See the file MLton-LICENSE for details.
  */
 
+#if (defined (MLTON_GC_INTERNAL))
+
 #define OBJPTR_TYPE__(z) uint ## z ## _t
 #define OBJPTR_TYPE_(z) OBJPTR_TYPE__(z)
 #define OBJPTR_TYPE OBJPTR_TYPE_(GC_MODEL_BITSIZE)
@@ -26,3 +28,5 @@
 objptr pointerToObjptr (pointer P, pointer B);
 pointer fetchObjptrToPointer (pointer OP, pointer B);
 void storeObjptrFromPointer (pointer OP, pointer P, pointer B);
+
+#endif /* (defined (MLTON_GC_INTERNAL)) */

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,10 +0,0 @@
-/* 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_pack (GC_state s);
-void GC_unpack (GC_state s);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -5,3 +5,9 @@
  * MLton is released under a BSD-style license.
  * See the file MLton-LICENSE for details.
  */
+
+/* isPointer returns true if p looks like a pointer. */
+bool isPointer (pointer p) {
+  uintptr_t mask = ~((~((uintptr_t)0)) << GC_MODEL_MINALIGN_SHIFT);
+  return (0 == ((uintptr_t)p & mask));
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,9 +6,6 @@
  * See the file MLton-LICENSE for details.
  */
 
-typedef unsigned char* pointer;
-#define POINTER_SIZE sizeof(pointer)
-#define FMTPTR "0x%016"PRIxPTR
 #define BOGUS_POINTER (pointer)0x1
 
 bool isPointer (pointer p);

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer_predicates.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer_predicates.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer_predicates.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,13 +0,0 @@
-/* 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.
- */
-
-/* isPointer returns true if p looks like a pointer. */
-bool isPointer (pointer p) {
-  uintptr_t mask = ~((~((uintptr_t)0)) << GC_MODEL_MINALIGN_SHIFT);
-  return (0 == ((uintptr_t)p & mask));
-}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -441,3 +441,12 @@
     }
   }
 }
+
+
+GC_profileData GC_getProfileCurrent (GC_state s) {
+  return s->profiling.data;
+}
+void GC_setProfileCurrent (GC_state s, GC_profileData p) {
+  s->profiling.data = p;
+}
+

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -81,11 +81,6 @@
 void GC_profileInc (GC_state s, size_t amount);
 void GC_profileAllocInc (GC_state s, size_t amount);
 
-GC_profileData GC_profileNew (GC_state s);
-void GC_profileFree (GC_state s, GC_profileData p);
-void GC_profileWrite (GC_state s, GC_profileData p, int fd);
-
 void GC_handleSigProf (pointer pc);
 void initProfiling (GC_state s);
-void GC_profileDone (GC_state s);
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,101 +6,23 @@
  * See the file MLton-LICENSE for details.
  */
 
-static inline char readChar (int fd) {
-  char res;
-  read_safe (fd, &res, sizeof(char));
-  return res;
-}
-
-static inline pointer readPointer (int fd) {
-  uintptr_t res;
-  read_safe (fd, &res, sizeof(uintptr_t));
-  return (pointer)res;
-}
-
 static inline objptr readObjptr (int fd) {
   objptr res;
   read_safe (fd, &res, sizeof(objptr));
   return res;
 }
 
-static inline size_t readSize (int fd) {
-  size_t res;
-  read_safe (fd, &res, sizeof(size_t));
-  return res;
-}
-
-static inline uint32_t readUint32 (int fd) {
-  uint32_t res;
-  read_safe (fd, &res, sizeof(uint32_t));
-  return res;
-}
-
-static inline uintptr_t readUintptr (int fd) {
+static inline pointer readPointer (int fd) {
   uintptr_t res;
   read_safe (fd, &res, sizeof(uintptr_t));
-  return res;
+  return (pointer)res;
 }
 
-static inline void writeChar (int fd, char c) {
-  write_safe (fd, &c, sizeof(char));
+static inline void writeObjptr (int fd, objptr op) {
+  write_safe (fd, &op, sizeof(objptr));
 }
 
 static inline void writePointer (int fd, pointer p) {
   uintptr_t u = (uintptr_t)p;
   write_safe (fd, &u, sizeof(uintptr_t));
 }
-
-static inline void writeObjptr (int fd, objptr op) {
-  write_safe (fd, &op, sizeof(objptr));
-}
-
-static inline void writeSize (int fd, size_t z) {
-  write_safe (fd, &z, sizeof(size_t));
-}
-
-static inline void writeUint32 (int fd, uint32_t u) {
-  write_safe (fd, &u, sizeof(uint32_t));
-}
-
-static inline void writeUintptr (int fd, uintptr_t u) {
-  write_safe (fd, &u, sizeof(uintptr_t));
-}
-
-static inline void writeString (int fd, char* s) {
-  write_safe (fd, s, strlen(s));
-}
-
-#define BUF_SIZE 81
-static inline void writeUint32U (int fd, uint32_t u) {
-  static char buf[BUF_SIZE];
-
-  sprintf (buf, "%"PRIu32, u);
-  writeString (fd, buf);
-}
-
-static inline void writeUintmaxU (int fd, uintmax_t u) {
-  static char buf[BUF_SIZE];
-
-  sprintf (buf, "%"PRIuMAX, u);
-  writeString (fd, buf);
-}
-
-static inline void writeUint32X (int fd, uint32_t u) {
-  static char buf[BUF_SIZE];
-  
-  sprintf (buf, "0x%08"PRIx32, u);
-  writeString (fd, buf);
-}
-
-static inline void writeUintmaxX (int fd, uintmax_t u) {
-  static char buf[BUF_SIZE];
-  
-  sprintf (buf, "0x%08"PRIxMAX, u);
-  writeString (fd, buf);
-}
-
-static inline void writeNewline (int fd) {
-  writeString (fd, "\n");
-}
-#undef BUF_SIZE

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -14,6 +14,6 @@
                      struct rusage *ru2,
                      struct rusage *ru);
 uintmax_t rusageTime (struct rusage *ru);
-uintmax_t currentTime (void);
+uintmax_t getCurrentTime (void);
 void startTiming (struct rusage *ru_start);
 uintmax_t stopTiming (struct rusage *ru_start, struct rusage *ru_gc);

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,80 +0,0 @@
-/* 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 *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 close_safe (int fd) {
-  int res;
-
-  res = close (fd);
-  if (-1 == res)
-    diee ("close (%d) failed.\n", fd);
-  return;
-}
-
-void *malloc_safe (size_t size) {
-  void *res;
-  
-  res = malloc (size);
-  if (NULL == res)
-    die ("malloc (%zu) failed.\n", size);
-  return res;
-}
-
-int mkstemp_safe (char *template) {
-  int fd;
-  
-  fd = mkstemp (template);
-  if (-1 == fd)
-    diee ("mkstemp (%s) failed.\n", template);
-  return fd;
-}
-
-int open_safe (const char *fileName, int flags, mode_t mode) {
-  int res;
-
-  res = open (fileName, flags, mode);
-  if (-1 == res)
-    diee ("open (%s,_,_) failed.\n", fileName);
-  return res;
-}
-
-void read_safe (int fd, void *buf, size_t size) {
-  ssize_t res;
-
-  if (0 == size) return;
-  res = read (fd, buf, size);
-  if (res == -1 or (size_t)res != size)
-    diee ("read (_, _, _) failed.\n");
-}
-
-void unlink_safe (const char *pathname) {
-  int res;
-
-  res = unlink (pathname);
-  if (-1 == res)
-    diee ("unlink (%s) failed.\n", pathname);
-  return;
-}
-
-void write_safe (int fd, const void *buf, size_t size) {
-  ssize_t res;
-
-  if (0 == size) return;
-  res = write (fd, buf, size);
-  if (res == -1 or (size_t)res != size)
-    diee ("write (_, _, _) failed.\n");
-}

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,9 +0,0 @@
-/* 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);

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,9 +0,0 @@
-/* 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.
- */
-
-size_t GC_size (GC_state s, pointer root);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -16,6 +16,18 @@
           stack->used);
 }
 
+
+bool isStackEmpty (GC_stack stack) {
+  return 0 == stack->used;
+}
+
+#if ASSERT
+bool isStackReservedAligned (GC_state s, size_t reserved) {
+  return isAligned (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved, 
+                    s->alignment);
+}
+#endif
+
 /* sizeofStackSlop returns the amount of "slop" space needed between
  * the top of the stack and the end of the stack space.
  */

Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -1,19 +0,0 @@
-/* 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.
- */
-
-bool isStackEmpty (GC_stack stack) {
-  return 0 == stack->used;
-}
-
-#if ASSERT
-bool isStackReservedAligned (GC_state s, size_t reserved) {
-  return isAligned (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved, 
-                    s->alignment);
-}
-#endif
-

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.c (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,7 @@
+/* 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.
+ */

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -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.
+ */
+
+/* Layout of strings.  
+ * Note, the value passed around is a pointer to the chars member.
+ */
+typedef struct GC_string {
+  GC_arrayCounter counter;
+  GC_arrayLength length;
+  GC_header header;
+  char chars[0];
+} *GC_string;
+
+#define GC_STRING_HEADER GC_WORD8_VECTOR_HEADER

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/switch-thread.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/switch-thread.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/switch-thread.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -7,4 +7,3 @@
  */
 
 void switchToThread (GC_state s, objptr op);
-void GC_switchToThread (GC_state s, GC_thread t, size_t ensureBytesFree);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -26,3 +26,4 @@
 
 void displayThread (GC_state s, GC_thread thread, FILE *stream);
 size_t sizeofThread (GC_state s);
+

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -37,25 +37,7 @@
 
 #include "../assert.h"
 
-#define TWOPOWER(n) (1 << (n))
 
-#ifndef TRUE
-#define TRUE    (0 == 0)
-#endif
-#ifndef FALSE
-#define FALSE   (not TRUE)
-#endif
-#define unless(p)       if (not (p))
-#define until(p)        while (not (p))
-
-#ifndef max
-#define max(a, b) ((a)>(b)?(a):(b))
-#endif
-
-#ifndef min
-#define min(a, b) ((a)<(b)?(a):(b))
-#endif
-
 /* issue error message and exit */
 extern void die (char *fmt, ...) 
   __attribute__ ((format(printf, 1, 2)))
@@ -64,3 +46,7 @@
 extern void diee (char *fmt, ...)
   __attribute__ ((format(printf, 1, 2)))
   __attribute__ ((noreturn));
+
+static inline size_t meg (size_t n) {
+  return n / (1024ul * 1024ul);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -10,4 +10,3 @@
 void loadWorldFromFileName (GC_state s, char *fileName);
 void saveWorldToFD (GC_state s, int fd);
 void GC_saveWorldToFD (GC_state s, int fd);
-

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,4811 +6,58 @@
  * See the file MLton-LICENSE for details.
  */
 
-#include "platform.h"
+#define MLTON_GC_INTERNAL
+#include "gc.h"
+#undef MLTON_GC_INTERNAL
+#include "gc/rusage.h"
+#include "gc/virtual-memory.h"
 
-/* The mutator should maintain the invariants
- *
- *  function entry: stackTop + maxFrameSize <= endOfStack
- *  anywhere else: stackTop + 2 * maxFrameSize <= endOfStack
- * 
- * The latter will give it enough space to make a function call and always
- * satisfy the former.  The former will allow it to make a gc call at the
- * function entry limit.
- */
+#include "gc/debug.c"
+#include "gc/virtual-memory.c"
+#include "gc/align.c"
+#include "gc/read_write.c"
 
-#ifndef DEBUG
-#define DEBUG FALSE
-#endif
-
-#ifndef DEBUG_PROFILE
-#define DEBUG_PROFILE FALSE
-#endif
-
-enum {
-        BOGUS_EXN_STACK = 0xFFFFFFFF,
-        CARD_SIZE_LOG2 = 8, /* must agree w/ cardSizeLog2 in ssa-to-rssa.fun */
-        COPY_CHUNK_SIZE = 0x2000000, /* 32M */
-        CROSS_MAP_EMPTY = 255,
-        CURRENT_SOURCE_UNDEFINED = 0xFFFFFFFF,
-        DEBUG_ARRAY = FALSE,
-        DEBUG_CALL_STACK = FALSE,
-        DEBUG_CARD_MARKING = FALSE,
-        DEBUG_DETAILED = FALSE,
-        DEBUG_ENTER_LEAVE = FALSE,
-        DEBUG_GENERATIONAL = FALSE,
-        DEBUG_MARK_COMPACT = FALSE,
-        DEBUG_RESIZING = FALSE,
-        DEBUG_SHARE = FALSE,
-        DEBUG_SIZE = FALSE,
-        DEBUG_STACKS = FALSE,
-        DEBUG_THREADS = FALSE,
-        DEBUG_WEAK = FALSE,
-        DEBUG_WORLD = FALSE,
-        FORCE_GENERATIONAL = FALSE,
-        FORCE_MARK_COMPACT = FALSE,
-        FORWARDED = 0xFFFFFFFF,
-        STACK_HEADER_SIZE = WORD_SIZE,
-};
-
-typedef enum {
-        MARK_MODE,
-        UNMARK_MODE,
-} MarkMode;
-
-#define EMPTY_HEADER GC_objectHeader (EMPTY_TYPE_INDEX)
-#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)
-
-#define SPLIT_HEADER()                                                          \
-        do {                                                                    \
-                int objectTypeIndex;                                            \
-                GC_ObjectType *t;                                               \
-                                                                                \
-                assert (1 == (header & 1));                                     \
-                objectTypeIndex = (header & TYPE_INDEX_MASK) >> 1;              \
-                assert (0 <= objectTypeIndex                                    \
-                                and objectTypeIndex < s->objectTypesSize);      \
-                t = &s->objectTypes [objectTypeIndex];                          \
-                tag = t->tag;                                                   \
-                hasIdentity = t->hasIdentity;                                   \
-                numNonPointers = t->numNonPointers;                             \
-                numPointers = t->numPointers;                                   \
-                if (DEBUG_DETAILED)                                             \
-                        fprintf (stderr, "SPLIT_HEADER (0x%08x)  numNonPointers = %u  numPointers = %u\n", \
-                                        (uint)header, numNonPointers, numPointers);     \
-        } while (0)
-
-static char* tagToString (GC_ObjectTypeTag t) {
-        switch (t) {
-        case ARRAY_TAG:
-        return "ARRAY";
-        case NORMAL_TAG:
-        return "NORMAL";
-        case STACK_TAG:
-        return "STACK";
-        case WEAK_TAG:
-        return "WEAK";
-        default:
-        die ("bad tag %u", t);
-        }
-}
-
-static inline ulong meg (uint n) {
-        return n / (1024ul * 1024ul);
-}
-
-static inline uint toBytes (uint n) {
-        return n << 2;
-}
-
-static inline W64 min64 (W64 x, W64 y) {
-        return ((x < y) ? x : y);
-}
-
-static inline W64 max64 (W64 x, W64 y) {
-        return ((x > y) ? x : y);
-}
-
-static inline uint roundDown (uint a, uint b) {
-        return a - (a % b);
-}
-
-static inline uint align (uint a, uint b) {
-        assert (a >= 0);
-        assert (b >= 1);
-        a += b - 1;
-        a -= a % b;
-        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 bool isAligned (uint a, uint b) {
-        return 0 == a % b;
-}
-
-#if ASSERT
-static bool isAlignedFrontier (GC_state s, pointer p) {
-        return isAligned ((uint)p + GC_NORMAL_HEADER_SIZE, s->alignment);
-}
-
-static bool isAlignedReserved (GC_state s, uint r) {
-        return isAligned (STACK_HEADER_SIZE + sizeof (struct GC_stack) + r, 
-                                s->alignment);
-}
-#endif
-
-static inline uint pad (GC_state s, uint bytes, uint extra) {
-        return align (bytes + extra, s->alignment) - extra;
-}
-
-static inline pointer alignFrontier (GC_state s, pointer p) {
-        return (pointer) pad (s, (uint)p, GC_NORMAL_HEADER_SIZE);
-}
-
-pointer GC_alignFrontier (GC_state s, pointer p) {
-        return alignFrontier (s, p);
-}
-
-static inline uint stackReserved (GC_state s, uint r) {
-        uint res;
-
-        res = pad (s, r, STACK_HEADER_SIZE + sizeof (struct GC_stack));
-        if (DEBUG_STACKS)
-                fprintf (stderr, "%s = stackReserved (%s)\n",
-                                uintToCommaString (res),
-                                uintToCommaString (r));
-        return res;
-}
-
-static void sunlink (char *path) {
-        unless (0 == unlink (path))
-                diee ("unlink (%s) failed", path);
-}
-
-/* ---------------------------------------------------------------- */
-/*                    Virtual Memory Management                     */
-/* ---------------------------------------------------------------- */
-
-static inline void *GC_mmapAnon (void *start, size_t length) {
-        void *res;
-
-        res = mmapAnon (start, length);
-        if (DEBUG_MEM)
-                fprintf (stderr, "0x%08x = mmapAnon (0x%08x, %s)\n",
-                                        (uint)res,
-                                        (uint)start, 
-                                        uintToCommaString (length));
-        return res;
-}
-
-void *smmap (size_t length) {
-        void *result;
-
-        result = GC_mmapAnon (NULL, length);
-        if ((void*)-1 == result) {
-                showMem ();
-                die ("Out of memory.");
-        }
-        return result;
-}
-
-static inline void GC_release (void *base, size_t length) {
-        if (DEBUG_MEM)
-                fprintf (stderr, "release (0x%08x, %s)\n",
-                                (uint)base, uintToCommaString (length));
-        release (base, length);
-}
-
-static inline void GC_decommit (void *base, size_t length) {
-        if (DEBUG_MEM)
-                fprintf (stderr, "decommit (0x%08x, %s)\n",
-                                (uint)base, uintToCommaString (length));
-        decommit (base, length);
-}
-
-static inline void copy (pointer src, pointer dst, uint size) {
-        uint    *to,
-                *from,
-                *limit;
-
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "copy (0x%08x, 0x%08x, %u)\n",
-                                (uint)src, (uint)dst, size);
-        assert (isAligned ((uint)src, WORD_SIZE));
-        assert (isAligned ((uint)dst, WORD_SIZE));
-        assert (isAligned (size, WORD_SIZE));
-        assert (dst <= src or src + size <= dst);
-        if (src == dst)
-                return;
-        from = (uint*)src;
-        to = (uint*)dst;
-        limit = (uint*)(src + size);
-        until (from == limit)
-                *to++ = *from++;
-}
-
-/* ---------------------------------------------------------------- */
-/*                              rusage                              */
-/* ---------------------------------------------------------------- */
-
-static inline void rusageZero (struct rusage *ru) {
-        memset (ru, 0, sizeof (*ru));
-}
-
-static void rusagePlusMax (struct rusage *ru1,
-                              struct rusage *ru2,
-                              struct rusage *ru) {
-        const int       million = 1000000;
-        time_t          sec,
-                        usec;
-
-        sec = ru1->ru_utime.tv_sec + ru2->ru_utime.tv_sec;
-        usec = ru1->ru_utime.tv_usec + ru2->ru_utime.tv_usec;
-        sec += (usec / million);
-        usec %= million;
-        ru->ru_utime.tv_sec = sec;
-        ru->ru_utime.tv_usec = usec;
-
-        sec = ru1->ru_stime.tv_sec + ru2->ru_stime.tv_sec;
-        usec = ru1->ru_stime.tv_usec + ru2->ru_stime.tv_usec;
-        sec += (usec / million);
-        usec %= million;
-        ru->ru_stime.tv_sec = sec;
-        ru->ru_stime.tv_usec = usec;
-}
-
-static void rusageMinusMax (struct rusage *ru1,
-                                struct rusage *ru2,
-                                struct rusage *ru) {
-        const int       million = 1000000;
-        time_t          sec,
-                        usec;
-
-        sec = (ru1->ru_utime.tv_sec - ru2->ru_utime.tv_sec) - 1;
-        usec = ru1->ru_utime.tv_usec + million - ru2->ru_utime.tv_usec;
-        sec += (usec / million);
-        usec %= million;
-        ru->ru_utime.tv_sec = sec;
-        ru->ru_utime.tv_usec = usec;
-
-        sec = (ru1->ru_stime.tv_sec - ru2->ru_stime.tv_sec) - 1;
-        usec = ru1->ru_stime.tv_usec + million - ru2->ru_stime.tv_usec;
-        sec += (usec / million);
-        usec %= million;
-        ru->ru_stime.tv_sec = sec;
-        ru->ru_stime.tv_usec = usec;
-}
-
-static uint rusageTime (struct rusage *ru) {
-        uint    result;
-
-        result = 0;
-        result += 1000 * ru->ru_utime.tv_sec;
-        result += 1000 * ru->ru_stime.tv_sec;
-        result += ru->ru_utime.tv_usec / 1000;
-        result += ru->ru_stime.tv_usec / 1000;
-        return result;
-}
-
-/* Return time as number of milliseconds. */
-static uint currentTime () {
-        struct rusage   ru;
-
-        fixedGetrusage (RUSAGE_SELF, &ru);
-        return rusageTime (&ru);
-}
-
-static inline void startTiming (struct rusage *ru_start) {
-        fixedGetrusage (RUSAGE_SELF, ru_start);
-}
-
-static uint stopTiming (struct rusage *ru_start, struct rusage *ru_gc) {
-        struct rusage ru_finish, ru_total;
-
-        fixedGetrusage (RUSAGE_SELF, &ru_finish);
-        rusageMinusMax (&ru_finish, ru_start, &ru_total);
-        rusagePlusMax (ru_gc, &ru_total, ru_gc);
-        return rusageTime (&ru_total);
-}
-
-/* ---------------------------------------------------------------- */
-/*                            GC_display                            */
-/* ---------------------------------------------------------------- */
-
-void GC_display (GC_state s, FILE *stream) {
-        fprintf (stream, "GC state\n\tcardMap = 0x%08x\n\toldGen = 0x%08x\n\toldGenSize = %s\n\toldGen + oldGenSize = 0x%08x\n\tnursery = 0x%08x\n\tfrontier = 0x%08x\n\tfrontier - nursery = %u\n\tlimitPlusSlop - frontier = %d\n",
-                        (uint) s->cardMap,
-                        (uint) s->heap.start,
-                        uintToCommaString (s->oldGenSize),
-                        (uint) s->heap.start + s->oldGenSize,
-                        (uint) s->nursery, 
-                        (uint) s->frontier,
-                        s->frontier - s->nursery,
-                        s->limitPlusSlop - s->frontier);
-        fprintf (stream, "\tcanHandle = %d\n\tsignalsIsPending = %d\n", s->canHandle, s->signalIsPending);
-        fprintf (stderr, "\tcurrentThread = 0x%08x\n", (uint) s->currentThread);
-        fprintf (stream, "\tstackBottom = 0x%08x\n\tstackTop - stackBottom = %u\n\tstackLimit - stackTop = %u\n",
-                        (uint)s->stackBottom,
-                        s->stackTop - s->stackBottom,
-                        (s->stackLimit - s->stackTop));
-        fprintf (stream, "\texnStack = %u\n\tbytesNeeded = %u\n\treserved = %u\n\tused = %u\n",
-                        s->currentThread->exnStack,
-                        s->currentThread->bytesNeeded,
-                        s->currentThread->stack->reserved,
-                        s->currentThread->stack->used);
-        if (DEBUG_GENERATIONAL and DEBUG_DETAILED) {
-                int i;
-
-                fprintf (stderr, "crossMap trues\n");
-                for (i = 0; i < s->crossMapSize; ++i)
-                        unless (CROSS_MAP_EMPTY == s->crossMap[i])
-                                fprintf (stderr, "\t%u\n", i);
-                fprintf (stderr, "\n");
-        }               
-}
-
-static inline uint cardNumToSize (GC_state s, uint n) {
-        return n << CARD_SIZE_LOG2;
-}
-
-static inline uint divCardSize (GC_state s, uint n) {
-        return n >> CARD_SIZE_LOG2;
-}
-
-static inline pointer cardMapAddr (GC_state s, pointer p) {
-        pointer res;
-
-        res = &s->cardMapForMutator [divCardSize (s, (uint)p)];
-        if (DEBUG_CARD_MARKING)
-                fprintf (stderr, "0x%08x = cardMapAddr (0x%08x)\n",
-                                (uint)res, (uint)p);
-        return res;
-}
-
-static inline bool cardIsMarked (GC_state s, pointer p) {
-        return *cardMapAddr (s, p);
-}
-
-static inline void markCard (GC_state s, pointer p) {
-        if (DEBUG_CARD_MARKING)
-                fprintf (stderr, "markCard (0x%08x)\n", (uint)p);
-        if (s->mutatorMarksCards)
-                *cardMapAddr (s, p) = '\001';
-}
-
-/* ---------------------------------------------------------------- */
-/*                              Stacks                              */
-/* ---------------------------------------------------------------- */
-
-/* stackSlop returns the amount of "slop" space needed between the top of 
- * the stack and the end of the stack space.
- */
-static inline uint stackSlop (GC_state s) {
-        return 2 * s->maxFrameSize;
-}
-
-static inline uint initialStackSize (GC_state s) {
-        return stackSlop (s);
-}
-
-static inline uint stackBytes (GC_state s, uint size) {
-        uint res;
-
-        res = align (STACK_HEADER_SIZE + sizeof (struct GC_stack) + size,
-                        s->alignment);
-        if (DEBUG_STACKS)
-                fprintf (stderr, "%s = stackBytes (%s)\n",
-                                uintToCommaString (res),
-                                uintToCommaString (size));
-        return res;
-}
-
-static inline pointer stackBottom (GC_state s, GC_stack stack) {
-        pointer res;
-
-        res = ((pointer)stack) + sizeof (struct GC_stack);
-        assert (isAligned ((uint)res, s->alignment));
-        return res;
-}
-
-/* Pointer to the topmost word in use on the stack. */
-static inline pointer stackTop (GC_state s, GC_stack stack) {
-        return stackBottom (s, stack) + stack->used;
-}
-
-/* Pointer to the end of stack. */
-static inline pointer endOfStack (GC_state s, GC_stack stack) {
-        return stackBottom (s, stack) + stack->reserved;
-}
-
-/* The maximum value stackTop may take on. */
-static inline pointer stackLimit (GC_state s, GC_stack stack) {
-        return endOfStack (s, stack) - stackSlop (s);
-}
-
-static inline bool stackIsEmpty (GC_stack stack) {
-        return 0 == stack->used;
-}
-
-static inline uint getFrameIndex (GC_state s, word returnAddress) {
-        uint res;
-
-        res = s->returnAddressToFrameIndex (returnAddress);
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "%u = getFrameIndex (0x%08x)\n",
-                                returnAddress, res);
-        return res;
-}
-
-static inline uint topFrameIndex (GC_state s) {
-        uint res;
-
-        assert (s->stackTop > s->stackBottom);
-        res = getFrameIndex (s, *(word*)(s->stackTop - WORD_SIZE));
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "topFrameIndex = %u\n", res);
-        return res;
-}
-
-static inline uint topFrameSourceSeqIndex (GC_state s) {
-        return s->frameSources[topFrameIndex (s)];
-}
-
-static inline GC_frameLayout * getFrameLayout (GC_state s, word returnAddress) {
-        GC_frameLayout *layout;
-        uint index;
-
-        index = getFrameIndex (s, returnAddress);
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "returnAddress = 0x%08x  index = %d  frameLayoutsSize = %d\n",
-                                returnAddress, index, s->frameLayoutsSize);
-        assert (0 <= index and index < s->frameLayoutsSize);
-        layout = &(s->frameLayouts[index]);
-        assert (layout->numBytes > 0);
-        return layout;
-}
-
-static inline uint topFrameSize (GC_state s, GC_stack stack) {
-        GC_frameLayout *layout;
-        
-        assert (not (stackIsEmpty (stack)));
-        layout = getFrameLayout (s, *(word*)(stackTop (s, stack) - WORD_SIZE));
-        return layout->numBytes;
-}
-
-static inline uint stackNeedsReserved (GC_state s, GC_stack stack) {
-        return stack->used + stackSlop (s) - topFrameSize (s, stack);
-}
-
-#if ASSERT
-static bool hasBytesFree (GC_state s, W32 oldGen, W32 nursery) {
-        bool res;
-
-        res = s->oldGenSize + oldGen 
-                        + (s->canMinor ? 2 : 1) 
-                                * (s->limitPlusSlop - s->nursery)
-                        <= s->heap.size
-                and nursery <= s->limitPlusSlop - s->frontier;
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "%s = hasBytesFree (%s, %s)\n",
-                                boolToString (res),
-                                uintToCommaString (oldGen),
-                                uintToCommaString (nursery));
-        return res;
-}
-#endif
-
-/* bytesRequested includes the header. */
-static pointer object (GC_state s, uint header, W32 bytesRequested,
-                                bool allocInOldGen,
-                                Bool hasDouble) {
-        pointer frontier;
-        pointer result;
-
-        if (DEBUG)
-                fprintf (stderr, "object (0x%08x, %u, %s)\n",
-                                header, 
-                                (uint)bytesRequested,
-                                boolToString (allocInOldGen));
-        assert (isAligned (bytesRequested, s->alignment));
-        assert (allocInOldGen
-                        ? hasBytesFree (s, bytesRequested, 0)
-                        : hasBytesFree (s, 0, bytesRequested));
-        if (allocInOldGen) {
-                frontier = s->heap.start + s->oldGenSize;
-                s->oldGenSize += bytesRequested;
-                s->bytesAllocated += bytesRequested;
-        } else {
-                if (DEBUG_DETAILED)
-                        fprintf (stderr, "frontier changed from 0x%08x to 0x%08x\n",
-                                        (uint)s->frontier, 
-                                        (uint)(s->frontier + bytesRequested));
-                frontier = s->frontier;
-                s->frontier += bytesRequested;
-        }
-        GC_profileAllocInc (s, bytesRequested);
-        *(uint*)(frontier) = header;
-        result = frontier + GC_NORMAL_HEADER_SIZE;
-        return result;
-}
-
-static GC_stack newStack (GC_state s, uint reserved, bool allocInOldGen) {
-        GC_stack stack;
-
-        reserved = stackReserved (s, reserved);
-        if (reserved > s->maxStackSizeSeen)
-                s->maxStackSizeSeen = reserved;
-        stack = (GC_stack) object (s, STACK_HEADER, stackBytes (s, reserved),
-                                        allocInOldGen, TRUE);
-        stack->reserved = reserved;
-        stack->used = 0;
-        if (DEBUG_STACKS)
-                fprintf (stderr, "0x%x = newStack (%u)\n", (uint)stack, 
-                                reserved);
-        return stack;
-}
-
-static void setStack (GC_state s) {
-        GC_stack stack;
-
-        s->exnStack = s->currentThread->exnStack;
-        stack = s->currentThread->stack;
-        s->stackBottom = stackBottom (s, stack);
-        s->stackTop = stackTop (s, stack);
-        s->stackLimit = stackLimit (s, stack);
-        /* We must card mark the stack because it will be updated by the mutator.
-         */
-        markCard (s, (pointer)stack);
-}
-
-static void stackCopy (GC_state s, GC_stack from, GC_stack to) {
-        assert (from->used <= to->reserved);
-        to->used = from->used;
-        if (DEBUG_STACKS)
-                fprintf (stderr, "stackCopy from 0x%08x to 0x%08x of length %u\n",
-                                (uint) stackBottom (s, from), 
-                                (uint) stackBottom (s, to),
-                                from->used);
-        memcpy (stackBottom (s, to), stackBottom (s, from), from->used);
-}
-
-/* Number of bytes used by the stack. */
-static inline uint currentStackUsed (GC_state s) {
-        return s->stackTop - s->stackBottom;
-}
-
-/* ---------------------------------------------------------------- */
-/*                          foreachGlobal                           */
-/* ---------------------------------------------------------------- */
-
-typedef void (*GC_pointerFun) (GC_state s, pointer *p);
-
-static inline void maybeCall (GC_pointerFun f, GC_state s, pointer *pp) {
-        if (GC_isPointer (*pp))
-                f (s, pp);
-}
-
-/* Apply f to each global pointer into the heap. */
-static inline void foreachGlobal (GC_state s, GC_pointerFun f) {
-        int i;
-
-        for (i = 0; i < s->globalsSize; ++i) {
-                if (DEBUG_DETAILED)
-                        fprintf (stderr, "foreachGlobal %u\n", i);
-                maybeCall (f, s, &s->globals [i]);
-        }
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "foreachGlobal threads\n");
-        maybeCall (f, s, (pointer*)&s->callFromCHandler);
-        maybeCall (f, s, (pointer*)&s->currentThread);
-        maybeCall (f, s, (pointer*)&s->savedThread);
-        maybeCall (f, s, (pointer*)&s->signalHandler);
-}
-
-#if ASSERT
-static pointer arrayPointer (GC_state s, 
-                                pointer a, 
-                                uint arrayIndex, 
-                                uint pointerIndex) {
-        Bool hasIdentity;
-        word header;
-        uint numPointers;
-        uint numNonPointers;
-        uint tag;
-
-        header = GC_getHeader (a);
-        SPLIT_HEADER();
-        assert (tag == ARRAY_TAG);
-        return a 
-                + arrayIndex * (numNonPointers + toBytes (numPointers))
-                + numNonPointers
-                + pointerIndex * POINTER_SIZE;
-}
-#endif
-
-/* The number of bytes in an array, not including the header. */
-static inline uint arrayNumBytes (GC_state s,
-                                        pointer p, 
-                                        uint numPointers,
-                                        uint numNonPointers) {
-        uint bytesPerElement;
-        uint numElements;
-        uint result;
-        
-        numElements = GC_arrayNumElements (p);
-        bytesPerElement = numNonPointers + toBytes (numPointers);
-        result = numElements * bytesPerElement;
-        /* Empty arrays have POINTER_SIZE bytes for the forwarding pointer */
-        if (0 == result) 
-                result = POINTER_SIZE;
-        return pad (s, result, GC_ARRAY_HEADER_SIZE);
-}
-
-/* ---------------------------------------------------------------- */
-/*                      foreachPointerInObject                      */
-/* ---------------------------------------------------------------- */
-/* foreachPointerInObject (s, p,f, ws) applies f to each pointer in the object
- * pointer to by p.
- * Returns pointer to the end of object, i.e. just past object.
- *
- * If ws, then the object pointer in weak objects is skipped.
- */
-
-static inline pointer foreachPointerInObject (GC_state s, pointer p,
-                                                Bool skipWeaks,
-                                                GC_pointerFun f) {
-        Bool hasIdentity;
-        word header;
-        uint numPointers;
-        uint numNonPointers;
-        uint tag;
-
-        header = GC_getHeader (p);
-        SPLIT_HEADER();
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "foreachPointerInObject p = 0x%x  header = 0x%x  tag = %s  numNonPointers = %d  numPointers = %d\n", 
-                        (uint)p, header, tagToString (tag), 
-                        numNonPointers, numPointers);
-        if (NORMAL_TAG == tag) {
-                pointer max;
-
-                p += toBytes (numNonPointers);
-                max = p + toBytes (numPointers);
-                /* Apply f to all internal pointers. */
-                for ( ; p < max; p += POINTER_SIZE) {
-                        if (DEBUG_DETAILED)
-                                fprintf (stderr, "p = 0x%08x  *p = 0x%08x\n",
-                                                (uint)p, *(uint*)p);
-                        maybeCall (f, s, (pointer*)p);
-                }
-        } else if (WEAK_TAG == tag) {
-                if (not skipWeaks and 1 == numPointers)
-                        maybeCall (f, s, (pointer*)&(((GC_weak)p)->object));
-                p += sizeof (struct GC_weak);
-        } else if (ARRAY_TAG == tag) {
-                uint bytesPerElement;
-                uint dataBytes;
-                pointer max;
-                uint numElements;
-
-                numElements = GC_arrayNumElements (p);
-                bytesPerElement = numNonPointers + toBytes (numPointers);
-                dataBytes = numElements * bytesPerElement;
-                /* Must check 0 == dataBytes before 0 == numPointers to correctly
-                 * handle arrays when both are true.
-                 */
-                if (0 == dataBytes)
-                        /* Empty arrays have space for forwarding pointer. */
-                        dataBytes = POINTER_SIZE;
-                else if (0 == numPointers)
-                        /* No pointers to process. */
-                        ;
-                else {
-                        max = p + dataBytes;
-                        if (0 == numNonPointers)
-                                /* Array with only pointers. */
-                                for (; p < max; p += POINTER_SIZE)
-                                        maybeCall (f, s, (pointer*)p);
-                        else {
-                                /* Array with a mix of pointers and non-pointers.
-                                 */
-                                uint numBytesPointers;
-                        
-                                numBytesPointers = toBytes (numPointers);
-                                /* For each array element. */
-                                while (p < max) {
-                                        pointer max2;
-
-                                        /* Skip the non-pointers. */
-                                        p += numNonPointers;
-                                        max2 = p + numBytesPointers;
-                                        /* For each internal pointer. */
-                                        for ( ; p < max2; p += POINTER_SIZE) 
-                                                maybeCall (f, s, (pointer*)p);
-                                }
-                        }
-                        assert (p == max);
-                        p -= dataBytes;
-                }
-                p += pad (s, dataBytes, GC_ARRAY_HEADER_SIZE);
-        } else { /* stack */
-                GC_stack stack;
-                pointer top, bottom;
-                int i;
-                word returnAddress;
-                GC_frameLayout *layout;
-                GC_offsets frameOffsets;
-
-                assert (STACK_TAG == tag);
-                stack = (GC_stack)p;
-                bottom = stackBottom (s, stack);
-                top = stackTop (s, stack);
-                assert (stack->used <= stack->reserved);
-                while (top > bottom) {
-                        /* Invariant: top points just past a "return address". */
-                        returnAddress = *(word*) (top - WORD_SIZE);
-                        if (DEBUG) {
-                                fprintf (stderr, "  top = %d  return address = ",
-                                                top - bottom);
-                                fprintf (stderr, "0x%08x.\n", returnAddress);
-                        }
-                        layout = getFrameLayout (s, returnAddress); 
-                        frameOffsets = layout->offsets;
-                        top -= layout->numBytes;
-                        for (i = 0 ; i < frameOffsets[0] ; ++i) {
-                                if (DEBUG)
-                                        fprintf(stderr, 
-                                                "    offset %u  address 0x%08x\n", 
-                                                frameOffsets[i + 1],
-                                                (uint)(*(pointer*)(top + frameOffsets[i + 1])));
-                                maybeCall(f, s, 
-                                          (pointer*)
-                                          (top + frameOffsets[i + 1]));
-                        }
-                }
-                assert(top == bottom);
-                p += sizeof (struct GC_stack) + stack->reserved;
-        }
-        return p;
-}
-
-/* ---------------------------------------------------------------- */
-/*                              toData                              */
-/* ---------------------------------------------------------------- */
-
-/* If p points at the beginning of an object, then toData p returns a pointer 
- * to the start of the object data.
- */
-static inline pointer toData (GC_state s, pointer p) {
-        word header;
-        pointer res;
-
-        assert (isAlignedFrontier (s, p));
-        header = *(word*)p;
-        if (0 == header)
-                /* Looking at the counter word in an array. */
-                res = p + GC_ARRAY_HEADER_SIZE;
-        else
-                /* Looking at a header word. */
-                res = p + GC_NORMAL_HEADER_SIZE;
-        assert (isAligned ((uint)res, s->alignment));
-        return res;
-}
-
-/* ---------------------------------------------------------------- */
-/*                      foreachPointerInRange                       */
-/* ---------------------------------------------------------------- */
-
-/* foreachPointerInRange (s, front, back, ws, f)
- * Apply f to each pointer between front and *back, which should be a 
- * contiguous sequence of objects, where front points at the beginning of
- * the first object and *back points just past the end of the last object.
- * f may increase *back (for example, this is done by forward).
- * foreachPointerInRange returns a pointer to the end of the last object it
- * visits.
- *
- * If ws, then the object pointer in weak objects is skipped.
- */
-
-static inline pointer foreachPointerInRange (GC_state s, 
-                                                pointer front, 
-                                                pointer *back,
-                                                Bool skipWeaks,
-                                                GC_pointerFun f) {
-        pointer b;
-
-        assert (isAlignedFrontier (s, front));
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "foreachPointerInRange  front = 0x%08x  *back = 0x%08x\n",
-                                (uint)front, *(uint*)back);
-        b = *back;
-        assert (front <= b);
-        while (front < b) {
-                while (front < b) {
-                        assert (isAligned ((uint)front, WORD_SIZE));
-                        if (DEBUG_DETAILED)
-                                fprintf (stderr, "front = 0x%08x  *back = 0x%08x\n",
-                                                (uint)front, *(uint*)back);
-                        front = foreachPointerInObject 
-                                        (s, toData (s, front), skipWeaks, f);
-                }
-                b = *back;
-        }
-        return front;
-}
-
-/* ---------------------------------------------------------------- */
-/*                            invariant                             */
-/* ---------------------------------------------------------------- */
-
-static bool mutatorFrontierInvariant (GC_state s) {
-        return (s->currentThread->bytesNeeded <= 
-                        s->limitPlusSlop - s->frontier);
-}
-
-static bool mutatorStackInvariant (GC_state s) {
-        return (stackTop (s, s->currentThread->stack) <= 
-                        stackLimit (s, s->currentThread->stack) + 
-                        topFrameSize (s, s->currentThread->stack));
-}
-
-static bool ratiosOk (GC_state s) {
-        return 1.0 < s->growRatio
-                        and 1.0 < s->nurseryRatio
-                        and 1.0 < s->markCompactRatio
-                        and s->markCompactRatio <= s->copyRatio
-                        and s->copyRatio <= s->liveRatio;
-}
-
-static inline bool isInNursery (GC_state s, pointer p) {
-        return s->nursery <= p and p < s->frontier;
-}
-
-#if ASSERT
-
-static inline bool isInOldGen (GC_state s, pointer p) {
-        return s->heap.start <= p and p < s->heap.start + s->oldGenSize;
-}
-
-static inline bool isInFromSpace (GC_state s, pointer p) {
-        return (isInOldGen (s, p) or isInNursery (s, p));
-}
-
-static inline void assertIsInFromSpace (GC_state s, pointer *p) {
-#if ASSERT
-        unless (isInFromSpace (s, *p))
-                die ("gc.c: assertIsInFromSpace p = 0x%08x  *p = 0x%08x);\n",
-                        (uint)p, *(uint*)p);
-        /* The following checks that intergenerational pointers have the
-         * appropriate card marked.  Unfortunately, it doesn't work because
-         * for stacks, the card containing the beginning of the stack is marked,
-         * but any remaining cards aren't.
-         */
-        if (FALSE and s->mutatorMarksCards 
-                and isInOldGen (s, (pointer)p) 
-                and isInNursery (s, *p)
-                and not cardIsMarked (s, (pointer)p)) {
-                GC_display (s, stderr);
-                die ("gc.c: intergenerational pointer from 0x%08x to 0x%08x with unmarked card.\n",
-                        (uint)p, *(uint*)p);
-        }
-#endif
-}
-
-static inline bool isInToSpace (GC_state s, pointer p) {
-        return (not (GC_isPointer (p))
-                        or (s->toSpace <= p and p < s->toLimit));
-}
-
-static bool invariant (GC_state s) {
-        int i;
-        pointer back;
-        GC_stack stack;
-
-        if (DEBUG)
-                fprintf (stderr, "invariant\n");
-        assert (ratiosOk (s));
-        /* Frame layouts */
-        for (i = 0; i < s->frameLayoutsSize; ++i) {
-                GC_frameLayout *layout;
-
-                layout = &(s->frameLayouts[i]);
-                if (layout->numBytes > 0) {
-                        GC_offsets offsets;
-//                      int j;
-
-                        assert (layout->numBytes <= s->maxFrameSize);
-                        offsets = layout->offsets;
-// No longer correct, since handler frames have a "size" (i.e. return address)
-// pointing into the middle of the frame.
-//                      for (j = 0; j < offsets[0]; ++j)
-//                              assert (offsets[j + 1] < layout->numBytes);
-                }
-        }
-        if (s->mutatorMarksCards) {
-                assert (s->cardMap == 
-                                &s->cardMapForMutator[divCardSize(s, (uint)s->heap.start)]);
-                assert (&s->cardMapForMutator[divCardSize (s, (uint)s->heap.start + s->heap.size - WORD_SIZE)]
-                                < s->cardMap + s->cardMapSize);
-        }
-        /* Heap */
-        assert (isAligned (s->heap.size, s->pageSize));
-        assert (isAligned ((uint)s->heap.start, s->cardSize));
-        assert (isAlignedFrontier (s, s->heap.start + s->oldGenSize));
-        assert (isAlignedFrontier (s, s->nursery));
-        assert (isAlignedFrontier (s, s->frontier));
-        assert (s->nursery <= s->frontier);
-        unless (0 == s->heap.size) {
-                assert (s->nursery <= s->frontier);
-                assert (s->frontier <= s->limitPlusSlop);
-                assert (s->limit == s->limitPlusSlop - LIMIT_SLOP);
-                assert (hasBytesFree (s, 0, 0));
-        }
-        assert (s->heap2.start == NULL or s->heap.size == s->heap2.size);
-        /* Check that all pointers are into from space. */
-        foreachGlobal (s, assertIsInFromSpace);
-        back = s->heap.start + s->oldGenSize;
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "Checking old generation.\n");
-        foreachPointerInRange (s, alignFrontier (s, s->heap.start), &back, FALSE,
-                                assertIsInFromSpace);
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "Checking nursery.\n");
-        foreachPointerInRange (s, s->nursery, &s->frontier, FALSE,
-                                assertIsInFromSpace);
-        /* Current thread. */
-        stack = s->currentThread->stack;
-        assert (isAlignedReserved (s, stack->reserved));
-        assert (s->stackBottom == stackBottom (s, stack));
-        assert (s->stackTop == stackTop (s, stack));
-        assert (s->stackLimit == stackLimit (s, stack));
-        assert (stack->used == currentStackUsed (s));
-        assert (stack->used <= stack->reserved);
-        assert (s->stackBottom <= s->stackTop);
-        if (DEBUG)
-                fprintf (stderr, "invariant passed\n");
-        return TRUE;
-}
-
-static bool mutatorInvariant (GC_state s, bool frontier, bool stack) {
-        if (DEBUG)
-                GC_display (s, stderr);
-        if (frontier)
-                assert (mutatorFrontierInvariant(s));
-        if (stack)
-                assert (mutatorStackInvariant(s));
-        assert (invariant (s));
-        return TRUE;
-}
-#endif /* #if ASSERT */
-
-/* ---------------------------------------------------------------- */
-/*                         enter and leave                          */
-/* ---------------------------------------------------------------- */
-
-static inline void atomicBegin (GC_state s) {
-        s->canHandle++;
-        if (0 == s->limit)
-                s->limit = s->limitPlusSlop - LIMIT_SLOP;
-}
-
-static inline void atomicEnd (GC_state s) {
-        s->canHandle--;
-        if (0 == s->canHandle and s->signalIsPending)
-                s->limit = 0;
-}
-
-/* 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. */
-        s->currentThread->stack->used = currentStackUsed (s);
-        s->currentThread->exnStack = s->exnStack;
-        if (DEBUG) 
-                GC_display (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");
-}
-
-/* ---------------------------------------------------------------- */
-/*                              Heaps                               */
-/* ---------------------------------------------------------------- */
-
-/* heapDesiredSize (s, l, c) returns the desired heap size for a heap with
- * l bytes live, given that the current heap size is c.
- */
-static W32 heapDesiredSize (GC_state s, W64 live, W32 currentSize) {
-        W32 res;
-        float ratio;
-
-        ratio = (float)s->ram / (float)live;
-        if (ratio >= s->liveRatio + s->growRatio) {
-                /* Cheney copying fits in RAM with desired liveRatio. */
-                res = live * s->liveRatio;
-                /* If the heap is currently close in size to what we want, leave
-                 * it alone.  Favor growing over shrinking.
-                 */
-                unless (res >= 1.1 * currentSize 
-                                or res <= .5 * currentSize)
-                        res = currentSize;
-        } else if (s->growRatio >= s->copyRatio
-                        and ratio >= 2 * s->copyRatio) {
-                /* Split RAM in half.  Round down by pageSize so that the total
-                 * amount of space taken isn't greater than RAM once rounding
-                 * happens.  This is so resizeHeap2 doesn't get confused and
-                 * free a semispace in a misguided attempt to avoid paging.
-                 */
-                res = roundDown (s->ram / 2, s->pageSize) ;
-        } else if (ratio >= s->copyRatio + s->growRatio) {
-                /* Cheney copying fits in RAM. */
-                res = s->ram - s->growRatio * live;
-                /* If the heap isn't too much smaller than what we want, leave
-                 * it alone.  On the other hand, if it is bigger we want to
-                 * leave res as is so that the heap is shrunk, to try to avoid
-                 * paging.
-                 */
-                if (0.9 * res <= currentSize and currentSize <= res)
-                        res = currentSize;
-        } else if (ratio >= s->markCompactRatio) {
-                /* Mark compact fits in ram.  It doesn't matter what the current
-                 * size is.  If the heap is currently smaller, we are using
-                 * copying and should switch to mark-compact.  If the heap is
-                 * currently bigger, we want to shrink back to ram size to avoid
-                 * paging.
-                 */
-                res = s->ram;
-        } else { /* Required live ratio. */
-                res = live * s->markCompactRatio;
-                /* If the current heap is bigger than res, the shrinking always
-                 * sounds like a good idea.  However, depending on what pages
-                 * the VM keeps around, growing could be very expensive, if it
-                 * involves paging the entire heap.  Hopefully the copy loop
-                 * in growFromSpace will make the right thing happen.
-                 */ 
-        }
-        if (s->fixedHeap > 0) {
-                if (res > s->fixedHeap / 2)
-                        res = s->fixedHeap;
-                else
-                        res = s->fixedHeap / 2;
-                if (res < live)
-                        die ("Out of memory with fixed heap size %s.",
-                                uintToCommaString (s->fixedHeap));
-        } else if (s->maxHeap > 0) {
-                if (res > s->maxHeap)
-                        res = s->maxHeap;
-                if (res < live)
-                        die ("Out of memory with max heap size %s.",
-                                uintToCommaString (s->maxHeap));
-        }
-        if (DEBUG_RESIZING)
-                fprintf (stderr, "%s = heapDesiredSize (%s)\n",
-                                uintToCommaString (res),
-                                ullongToCommaString (live));
-        assert (res >= live);
-        return res;
-}
-
-static inline void heapInit (GC_heap h) {
-        h->size = 0;
-        h->start = NULL;
-}
-
-static inline bool heapIsInit (GC_heap h) {
-        return 0 == h->size;
-}
-
-static void heapRelease (GC_state s, GC_heap h) {
-        if (NULL == h->start)
-                return;
-        if (DEBUG or s->messages)
-                fprintf (stderr, "Releasing heap at 0x%08x of size %s.\n", 
-                                (uint)h->start, 
-                                uintToCommaString (h->size));
-        GC_release (h->start, h->size);
-        heapInit (h);
-}
-
-static void heapShrink (GC_state s, GC_heap h, W32 keep) {
-        assert (keep <= h->size);
-        if (0 == keep) {
-                heapRelease (s, h);
-                return;
-        }
-        keep = align (keep, s->pageSize);
-        if (keep < h->size) {
-                if (DEBUG or s->messages)
-                        fprintf (stderr, 
-                                "Shrinking heap at 0x%08x of size %s to %s bytes.\n",
-                                (uint)h->start, 
-                                uintToCommaString (h->size),
-                                uintToCommaString (keep));
-                GC_decommit (h->start + keep, h->size - keep);
-                h->size = keep;
-        }
-}
-
-static void clearCardMap (GC_state s) {
-        memset (s->cardMap, 0, s->cardMapSize);
-}
-
-static void setNursery (GC_state s, W32 oldGenBytesRequested,
-                                W32 nurseryBytesRequested) {
-        GC_heap h;
-        uint nurserySize;
-
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "setNursery.  oldGenBytesRequested = %s  frontier = 0x%08x\n",  
-                                uintToCommaString (oldGenBytesRequested),
-                                (uint)s->frontier);
-        h = &s->heap;
-        assert (isAlignedFrontier (s, h->start + s->oldGenSize 
-                                        + oldGenBytesRequested));
-        nurserySize = h->size - s->oldGenSize - oldGenBytesRequested;
-        s->limitPlusSlop = h->start + h->size;
-        s->limit = s->limitPlusSlop - LIMIT_SLOP;
-        assert (isAligned (nurserySize, WORD_SIZE));
-        if (    /* The mutator marks cards. */
-                s->mutatorMarksCards
-                /* There is enough space in the nursery. */
-                and (nurseryBytesRequested 
-                        <= s->limitPlusSlop
-                                - alignFrontier (s, s->limitPlusSlop
-                                                        - nurserySize/2 + 2))
-                /* The nursery is large enough to be worth it. */
-                and (((float)(h->size - s->bytesLive) 
-                        / (float)nurserySize) <= s->nurseryRatio)
-                and /* There is a reason to use generational GC. */
-                (
-                /* We must use it for debugging pruposes. */
-                FORCE_GENERATIONAL
-                /* We just did a mark compact, so it will be advantageous to
-                 * to use it.
-                 */
-                or (s->lastMajor == GC_MARK_COMPACT)
-                /* The live ratio is low enough to make it worthwhile. */
-                or (float)h->size / (float)s->bytesLive 
-                        <= (h->size < s->ram
-                                ? s->copyGenerationalRatio
-                                : s->markCompactGenerationalRatio)
-                )) {
-                s->canMinor = TRUE;
-                nurserySize /= 2;
-                unless (isAligned (nurserySize, WORD_SIZE))
-                        nurserySize -= 2;
-                clearCardMap (s);
-        } else {
-                unless (nurseryBytesRequested 
-                                <= s->limitPlusSlop
-                                        - alignFrontier (s, s->limitPlusSlop
-                                                                - nurserySize))
-                        die ("Out of memory.  Insufficient space in nursery.");
-                s->canMinor = FALSE;
-        }
-        assert (nurseryBytesRequested 
-                        <= s->limitPlusSlop
-                                - alignFrontier (s, s->limitPlusSlop 
-                                                        - nurserySize));
-        s->nursery = alignFrontier (s, s->limitPlusSlop - nurserySize);
-        s->frontier = s->nursery;
-        assert (nurseryBytesRequested <= s->limitPlusSlop - s->frontier);
-        assert (isAlignedFrontier (s, s->nursery));
-        assert (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
-}
-
-static inline void clearCrossMap (GC_state s) {
-        if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
-                fprintf (stderr, "clearCrossMap ()\n");
-        s->crossMapValidSize = 0;
-        memset (s->crossMap, CROSS_MAP_EMPTY, s->crossMapSize);
-}
-
-static void setCardMapForMutator (GC_state s) {
-        unless (s->mutatorMarksCards)
-                return;
-        /* It's OK if the subtraction below underflows because all the 
-         * subsequent additions to mark the cards will overflow and put us
-         * in the right place.
-         */
-        s->cardMapForMutator = s->cardMap - divCardSize (s, (uint)s->heap.start);
-        if (DEBUG_CARD_MARKING)
-                fprintf (stderr, "cardMapForMutator = 0x%08x\n",
-                                (uint)s->cardMapForMutator);
-}
-
-static void createCardMapAndCrossMap (GC_state s) {
-        GC_heap h;
-
-        unless (s->mutatorMarksCards) {
-                s->cardMapSize = 0;
-                s->cardMap = NULL;
-                s->cardMapForMutator = NULL;
-                s->crossMapSize = 0;
-                s->crossMap = NULL;
-                return;
-        }
-        h = &s->heap;
-        assert (isAligned (h->size, s->cardSize));
-        s->cardMapSize = align (divCardSize (s, h->size), s->pageSize);
-        s->crossMapSize = s->cardMapSize;
-        if (DEBUG_MEM)
-                fprintf (stderr, "Creating card/cross map of size %s\n",
-                                uintToCommaString
-                                        (s->cardMapSize + s->crossMapSize));
-        s->cardMap = smmap (s->cardMapSize + s->crossMapSize);
-        s->crossMap = (uchar *)s->cardMap + s->cardMapSize;
-        if (DEBUG_CARD_MARKING)
-                fprintf (stderr, "cardMap = 0x%08x  crossMap = 0x%08x\n", 
-                                (uint)s->cardMap,
-                                (uint)s->crossMap);
-        setCardMapForMutator (s);
-        clearCrossMap (s);
-}
-
-/* heapCreate (s, h, need, minSize) allocates a heap of the size necessary to
- * work with need 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, W32 desiredSize, W32 minSize) {
-        W32 backoff;
-
-        if (DEBUG_MEM)
-                fprintf (stderr, "heapCreate  desired size = %s  min size = %s\n",
-                                uintToCommaString (desiredSize),
-                                uintToCommaString (minSize));
-        assert (heapIsInit (h));
-        if (desiredSize < minSize)
-                desiredSize = minSize;
-        desiredSize = align (desiredSize, s->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->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 int direction = 1;
-                int i;
-
-                assert (isAligned (h->size, s->pageSize));
-                for (i = 0; i < 32; i++) {
-                        unsigned long address;
-
-                        address = i * 0x08000000ul;
-                        if (direction)
-                                address = 0xf8000000ul - address;
-                        h->start = GC_mmapAnon ((void*)address, h->size);
-                        if ((void*)-1 == h->start)
-                                h->start = (void*)NULL;
-                        unless ((void*)NULL == h->start) {
-                                direction = (0 == direction);
-                                if (h->size > s->maxHeapSizeSeen)
-                                        s->maxHeapSizeSeen = h->size;
-                                if (DEBUG or s->messages)
-                                        fprintf (stderr, "Created heap of size %s at 0x%08x.\n",
-                                                        uintToCommaString (h->size),
-                                                        (uint)h->start);
-                                assert (h->size >= minSize);
-                                return TRUE;
-                        }
-                }
-                if (s->messages)
-                        fprintf(stderr, "[Requested %luM cannot be satisfied, backing off by %luM (min size = %luM).\n",
-                                meg (h->size), meg (backoff), meg (minSize));
-        }
-        h->size = 0;
-        return FALSE;
-}
-
-static inline uint objectSize (GC_state s, pointer p) {
-        Bool hasIdentity;
-        uint headerBytes, objectBytes;
-        word header;
-        uint tag, numPointers, numNonPointers;
-
-        header = GC_getHeader (p);
-        SPLIT_HEADER();
-        if (NORMAL_TAG == tag) { /* Fixed size object. */
-                headerBytes = GC_NORMAL_HEADER_SIZE;
-                objectBytes = toBytes (numPointers + numNonPointers);
-        } else if (ARRAY_TAG == tag) {
-                headerBytes = GC_ARRAY_HEADER_SIZE;
-                objectBytes = arrayNumBytes (s, p, numPointers, numNonPointers);
-        } else if (WEAK_TAG == tag) {
-                headerBytes = GC_NORMAL_HEADER_SIZE;
-                objectBytes = sizeof (struct GC_weak);
-        } else { /* Stack. */
-                assert (STACK_TAG == tag);
-                headerBytes = STACK_HEADER_SIZE;
-                objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
-        }
-        return headerBytes + objectBytes;
-}
-
-/* ---------------------------------------------------------------- */
-/*                    Cheney Copying Collection                     */
-/* ---------------------------------------------------------------- */
-
-/* forward (s, pp) forwards the object pointed to by *pp and updates *pp to 
- * point to the new object. 
- * It also updates the crossMap.
- */
-static inline void forward (GC_state s, pointer *pp) {
-        pointer p;
-        word header;
-        word tag;
-
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "forward  pp = 0x%x  *pp = 0x%x\n", (uint)pp, *(uint*)pp);
-        assert (isInFromSpace (s, *pp));
-        p = *pp;
-        header = GC_getHeader (p);
-        if (DEBUG_DETAILED and FORWARDED == header)
-                fprintf (stderr, "already FORWARDED\n");
-        if (header != FORWARDED) { /* forward the object */
-                Bool hasIdentity;
-                uint headerBytes, objectBytes, size, skip;
-                uint numPointers, numNonPointers;
-
-                /* Compute the space taken by the header and object body. */
-                SPLIT_HEADER();
-                if (NORMAL_TAG == tag) { /* Fixed size object. */
-                        headerBytes = GC_NORMAL_HEADER_SIZE;
-                        objectBytes = toBytes (numPointers + numNonPointers);
-                        skip = 0;
-                } else if (ARRAY_TAG == tag) {
-                        headerBytes = GC_ARRAY_HEADER_SIZE;
-                        objectBytes = arrayNumBytes (s, p, numPointers,
-                                                        numNonPointers);
-                        skip = 0;
-                } else if (WEAK_TAG == tag) {
-                        headerBytes = GC_NORMAL_HEADER_SIZE;
-                        objectBytes = sizeof (struct GC_weak);
-                        skip = 0;
-                } else { /* Stack. */
-                        GC_stack stack;
-
-                        assert (STACK_TAG == tag);
-                        headerBytes = STACK_HEADER_SIZE;
-                        stack = (GC_stack)p;
-
-                        if (s->currentThread->stack == stack) {
-                                /* Shrink stacks that don't use a lot 
-                                 * of their reserved space;
-                                 * but don't violate the stack invariant.
-                                 */
-                                if (stack->used <= stack->reserved / 4) {
-                                        uint new = stackReserved (s, max (stack->reserved / 2,
-                                                                                stackNeedsReserved (s, stack)));
-                                        /* It's possible that new > stack->reserved if
-                                         * the stack invariant is violated. In that case, 
-                                         * we want to leave the stack alone, because some 
-                                         * other part of the gc will grow the stack.  We 
-                                         * cannot do any growing here because we may run 
-                                         * out of to space.
-                                         */
-                                        if (new <= stack->reserved) {
-                                                stack->reserved = new;
-                                                if (DEBUG_STACKS)
-                                                        fprintf (stderr, "Shrinking stack to size %s.\n",
-                                                                        uintToCommaString (stack->reserved));
-                                        }
-                                }
-                        } else {
-                                /* Shrink heap stacks.
-                                 */
-                                stack->reserved = stackReserved (s, max(s->threadShrinkRatio * stack->reserved, 
-                                                                        stack->used));
-                                if (DEBUG_STACKS)
-                                        fprintf (stderr, "Shrinking stack to size %s.\n",
-                                                        uintToCommaString (stack->reserved));
-                        }
-                        objectBytes = sizeof (struct GC_stack) + stack->used;
-                        skip = stack->reserved - stack->used;
-                }
-                size = headerBytes + objectBytes;
-                assert (s->back + size + skip <= s->toLimit);
-                /* Copy the object. */
-                copy (p - headerBytes, s->back, size);
-                /* If the object has a valid weak pointer, link it into the weaks
-                 * for update after the copying GC is done.
-                 */
-                if (WEAK_TAG == tag and 1 == numPointers) {
-                        GC_weak w;
-
-                        w = (GC_weak)(s->back + GC_NORMAL_HEADER_SIZE);
-                        if (DEBUG_WEAK)
-                                fprintf (stderr, "forwarding weak 0x%08x ",
-                                                (uint)w);
-                        if (GC_isPointer (w->object)
-                                and (not s->amInMinorGC
-                                        or isInNursery (s, w->object))) {
-                                if (DEBUG_WEAK)
-                                        fprintf (stderr, "linking\n");
-                                w->link = s->weaks;
-                                s->weaks = w;
-                        } else {
-                                if (DEBUG_WEAK)
-                                        fprintf (stderr, "not linking\n");
-                        }
-                }
-                /* Store the forwarding pointer in the old object. */
-                *(word*)(p - WORD_SIZE) = FORWARDED;
-                *(pointer*)p = s->back + headerBytes;
-                /* Update the back of the queue. */
-                s->back += size + skip;
-                assert (isAligned ((uint)s->back + GC_NORMAL_HEADER_SIZE,
-                                        s->alignment));
-        }
-        *pp = *(pointer*)p;
-        assert (isInToSpace (s, *pp));
-}
-
-static void updateWeaks (GC_state s) {
-        GC_weak w;
-
-        for (w = s->weaks; w != NULL; w = w->link) {
-                assert ((pointer)BOGUS_POINTER != w->object);
-
-                if (DEBUG_WEAK)
-                        fprintf (stderr, "updateWeaks  w = 0x%08x  ", (uint)w);
-                if (FORWARDED == GC_getHeader ((pointer)w->object)) {
-                        if (DEBUG_WEAK)
-                                fprintf (stderr, "forwarded from 0x%08x to 0x%08x\n",
-                                                (uint)w->object,
-                                                (uint)*(pointer*)w->object);
-                        w->object = *(pointer*)w->object;
-                } else {
-                        if (DEBUG_WEAK)
-                                fprintf (stderr, "cleared\n");
-                        *(GC_getHeaderp((pointer)w)) = WEAK_GONE_HEADER;
-                        w->object = (pointer)BOGUS_POINTER;
-                }
-        }
-        s->weaks = NULL;
-}
-
-static void swapSemis (GC_state s) {
-        struct GC_heap h;
-
-        h = s->heap2;
-        s->heap2 = s->heap;
-        s->heap = h;
-        setCardMapForMutator (s);
-}
-
-static inline bool detailedGCTime (GC_state s) {
-        return s->summary;
-}
-
-static void cheneyCopy (GC_state s) {
-        struct rusage ru_start;
-        pointer toStart;
-
-        assert (s->heap2.size >= s->oldGenSize);
-        if (detailedGCTime (s))
-                startTiming (&ru_start);
-        s->numCopyingGCs++;
-        s->toSpace = s->heap2.start;
-        s->toLimit = s->heap2.start + s->heap2.size;
-        if (DEBUG or s->messages) {
-                fprintf (stderr, "Major copying GC.\n");
-                fprintf (stderr, "fromSpace = 0x%08x of size %s\n", 
-                                (uint) s->heap.start,
-                                uintToCommaString (s->heap.size));
-                fprintf (stderr, "toSpace = 0x%08x of size %s\n",
-                                (uint) s->heap2.start,
-                                uintToCommaString (s->heap2.size));
-        }
-        assert (s->heap2.start != (void*)NULL);
-        /* The next assert ensures there is enough space for the copy to succeed.
-         * It does not assert (s->heap2.size >= s->heap.size) because that
-         * is too strong.
-         */
-        assert (s->heap2.size >= s->oldGenSize);
-        toStart = alignFrontier (s, s->heap2.start);
-        s->back = toStart;
-        foreachGlobal (s, forward);
-        foreachPointerInRange (s, toStart, &s->back, TRUE, forward);
-        updateWeaks (s);
-        s->oldGenSize = s->back - s->heap2.start;
-        s->bytesCopied += s->oldGenSize;
-        if (DEBUG)
-                fprintf (stderr, "%s bytes live.\n", 
-                                uintToCommaString (s->oldGenSize));
-        swapSemis (s);
-        clearCrossMap (s);
-        s->lastMajor = GC_COPYING;
-        if (detailedGCTime (s))
-                stopTiming (&ru_start, &s->ru_gcCopy);          
-        if (DEBUG or s->messages)
-                fprintf (stderr, "Major copying GC done.\n");
-}
-
-/* ---------------------------------------------------------------- */
-/*                     Minor copying collection                     */
-/* ---------------------------------------------------------------- */
-
-#if ASSERT
-
-static inline pointer crossMapCardStart (GC_state s, pointer p) {
-        /* The p - 1 is so that a pointer to the beginning of a card
-         * falls into the index for the previous crossMap entry.
-         */
-        return (p == s->heap.start)
-                ? s->heap.start
-                : (p - 1) - ((uint)(p - 1) % s->cardSize);
-}
-
-/* crossMapIsOK is a slower, but easier to understand, way of computing the
- * crossMap.  updateCrossMap (below) incrementally updates the crossMap, checking
- * only the part of the old generation that it hasn't seen before.  crossMapIsOK
- * simply walks through the entire old generation.  It is useful to check that
- * the incremental update is working correctly.
- */
-static bool crossMapIsOK (GC_state s) {
-        pointer back;
-        uint cardIndex;
-        pointer cardStart;
-        pointer front;
-        uint i;
-        static uchar *m;
-
-        if (DEBUG)
-                fprintf (stderr, "crossMapIsOK ()\n");
-        m = smmap (s->crossMapSize);
-        memset (m, CROSS_MAP_EMPTY, s->crossMapSize);
-        back = s->heap.start + s->oldGenSize;
-        cardIndex = 0;
-        front = alignFrontier (s, s->heap.start);
-loopObjects:
-        assert (front <= back);
-        cardStart = crossMapCardStart (s, front);
-        cardIndex = divCardSize (s, cardStart - s->heap.start);
-        m[cardIndex] = (front - cardStart) / WORD_SIZE;
-        if (front < back) {
-                front += objectSize (s, toData (s, front));
-                goto loopObjects;
-        }
-        for (i = 0; i < cardIndex; ++i)
-                assert (m[i] == s->crossMap[i]);
-        GC_release (m, s->crossMapSize);
-        return TRUE;
-}
-
-#endif /* ASSERT */
-
-static void updateCrossMap (GC_state s) {
-        GC_heap h;
-        pointer cardEnd;
-        uint cardIndex;
-        pointer cardStart;
-        pointer next;
-        pointer objectStart;
-        pointer oldGenEnd;
-
-        h = &(s->heap);
-        if (s->crossMapValidSize == s->oldGenSize)
-                goto done;
-        oldGenEnd = h->start + s->oldGenSize;
-        objectStart = h->start + s->crossMapValidSize;
-        if (objectStart == h->start) {
-                cardIndex = 0;
-                objectStart = alignFrontier (s, objectStart);
-        } else
-                cardIndex = divCardSize (s, (uint)(objectStart - 1 - h->start));
-        cardStart = h->start + cardNumToSize (s, cardIndex);
-        cardEnd = cardStart + s->cardSize;
-loopObjects:
-        assert (objectStart < oldGenEnd);
-        assert ((objectStart == h->start or cardStart < objectStart)
-                        and objectStart <= cardEnd);
-        next = objectStart + objectSize (s, toData (s, objectStart));
-        if (next > cardEnd) {
-                /* We're about to move to a new card, so we are looking at the
-                 * last object boundary in the current card.  Store it in the 
-                 * crossMap.
-                 */
-                uint offset;
-
-                offset = (objectStart - cardStart) / WORD_SIZE;
-                assert (offset < CROSS_MAP_EMPTY);
-                if (DEBUG_GENERATIONAL)
-                        fprintf (stderr, "crossMap[%u] = %u\n", 
-                                        cardIndex, offset);
-                s->crossMap[cardIndex] = offset;
-                cardIndex = divCardSize (s, next - 1 - h->start);
-                cardStart = h->start + cardNumToSize (s, cardIndex);
-                cardEnd = cardStart + s->cardSize;
-        }
-        objectStart = next;
-        if (objectStart < oldGenEnd) 
-                goto loopObjects;
-        assert (objectStart == oldGenEnd);
-        s->crossMap[cardIndex] = (oldGenEnd - cardStart) / WORD_SIZE;
-        s->crossMapValidSize = s->oldGenSize;
-done:
-        assert (s->crossMapValidSize == s->oldGenSize);
-        assert (crossMapIsOK (s));
-}
-
-static inline void forwardIfInNursery (GC_state s, pointer *pp) {
-        pointer p;
-
-        p = *pp;
-        if (p < s->nursery)
-                return;
-        if (DEBUG_GENERATIONAL)
-                fprintf (stderr, "intergenerational pointer from 0x%08x to 0x%08x\n",
-                        (uint)pp, *(uint*)pp);
-        assert (s->nursery <= p and p < s->limitPlusSlop);
-        forward (s, pp);
-}
-
-
-/* Walk through all the cards and forward all intergenerational pointers. */
-static void forwardInterGenerationalPointers (GC_state s) {
-        pointer cardMap;
-        uint cardNum;
-        pointer cardStart;
-        uchar *crossMap;
-        GC_heap h;
-        uint numCards;
-        pointer objectStart;
-        pointer oldGenStart;
-        pointer oldGenEnd;
-
-        if (DEBUG_GENERATIONAL)
-                fprintf (stderr, "Forwarding inter-generational pointers.\n");
-        updateCrossMap (s);
-        h = &s->heap;
-        /* Constants. */
-        cardMap = s->cardMap;
-        crossMap = s->crossMap;
-        numCards = divCardSize (s, align (s->oldGenSize, s->cardSize));
-        oldGenStart = s->heap.start;
-        oldGenEnd = oldGenStart + s->oldGenSize;
-        /* Loop variables*/
-        objectStart = alignFrontier (s, s->heap.start);
-        cardNum = 0;
-        cardStart = oldGenStart;
-checkAll:
-        assert (cardNum <= numCards);
-        assert (isAlignedFrontier (s, objectStart));
-        if (cardNum == numCards)
-                goto done;
-checkCard:
-        if (DEBUG_GENERATIONAL)
-                fprintf (stderr, "checking card %u  objectStart = 0x%08x  cardEnd = 0x%08x\n",
-                                cardNum, 
-                                (uint)objectStart,
-                                (uint)oldGenStart + cardNumToSize (s, cardNum + 1));
-        assert (objectStart < oldGenStart + cardNumToSize (s, cardNum + 1));
-        if (cardMap[cardNum]) {
-                pointer cardEnd;
-                pointer orig;
-                uint size;
-
-                s->markedCards++;
-                if (DEBUG_GENERATIONAL)
-                        fprintf (stderr, "card %u is marked  objectStart = 0x%08x\n", 
-                                        cardNum, (uint)objectStart);
-                orig = objectStart;
-skipObjects:
-                assert (isAlignedFrontier (s, objectStart));
-                size = objectSize (s, toData (s, objectStart));
-                if (objectStart + size < cardStart) {
-                        objectStart += size;
-                        goto skipObjects;
-                }
-                s->minorBytesSkipped += objectStart - orig;
-                cardEnd = cardStart + s->cardSize;
-                if (oldGenEnd < cardEnd) 
-                        cardEnd = oldGenEnd;
-                assert (objectStart < cardEnd);
-                orig = objectStart;
-                /* If we ever add Weak.set, then there could be intergenerational
-                 * weak pointers, in which case we would need to link the weak
-                 * objects into s->weaks.  But for now, since there is no 
-                 * Weak.set, the foreachPointerInRange will do the right thing
-                 * on weaks, since the weak pointer will never be into the 
-                 * nursery.
-                 */
-                objectStart = 
-                        foreachPointerInRange (s, objectStart, &cardEnd, FALSE,
-                                                forwardIfInNursery);
-                s->minorBytesScanned += objectStart - orig;
-                if (objectStart == oldGenEnd)
-                        goto done;
-                cardNum = divCardSize (s, objectStart - oldGenStart);
-                cardStart = oldGenStart + cardNumToSize (s, cardNum);
-                goto checkCard;
-        } else {
-                unless (CROSS_MAP_EMPTY == crossMap[cardNum])
-                        objectStart = cardStart + crossMap[cardNum] * WORD_SIZE;
-                if (DEBUG_GENERATIONAL)
-                        fprintf (stderr, "card %u is not marked  crossMap[%u] == %u  objectStart = 0x%08x\n", 
-                                        cardNum,
-                                        cardNum, 
-                                        crossMap[cardNum] * WORD_SIZE,
-                                        (uint)objectStart);
-                cardNum++;
-                cardStart += s->cardSize;
-                goto checkAll;
-        }
-        assert (FALSE);
-done:
-        if (DEBUG_GENERATIONAL)
-                fprintf (stderr, "Forwarding inter-generational pointers done.\n");
-}
-
-static void minorGC (GC_state s) {
-        W32 bytesAllocated;
-        W32 bytesCopied;
-        struct rusage ru_start;
-
-        if (DEBUG_GENERATIONAL)
-                fprintf (stderr, "minorGC  nursery = 0x%08x  frontier = 0x%08x\n", 
-                                (uint)s->nursery,
-                                (uint)s->frontier);
-        assert (invariant (s));
-        bytesAllocated = s->frontier - s->nursery;
-        if (bytesAllocated == 0)
-                return;
-        s->bytesAllocated += bytesAllocated;
-        if (not s->canMinor) {
-                s->oldGenSize += bytesAllocated;
-                bytesCopied = 0;
-        } else {
-                if (DEBUG_GENERATIONAL or s->messages)
-                        fprintf (stderr, "Minor GC.\n");
-                if (detailedGCTime (s))
-                        startTiming (&ru_start);
-                s->amInMinorGC = TRUE;
-                s->toSpace = s->heap.start + s->oldGenSize;
-                if (DEBUG_GENERATIONAL)
-                        fprintf (stderr, "toSpace = 0x%08x\n",
-                                        (uint)s->toSpace);
-                assert (isAlignedFrontier (s, s->toSpace));
-                s->toLimit = s->toSpace + bytesAllocated;
-                assert (invariant (s));
-                s->numMinorGCs++;
-                s->numMinorsSinceLastMajor++;
-                s->back = s->toSpace;
-                /* Forward all globals.  Would like to avoid doing this once all
-                 * the globals have been assigned.
-                 */
-                foreachGlobal (s, forwardIfInNursery);
-                forwardInterGenerationalPointers (s);
-                foreachPointerInRange (s, s->toSpace, &s->back, TRUE,
-                                        forwardIfInNursery);
-                updateWeaks (s);
-                bytesCopied = s->back - s->toSpace;
-                s->bytesCopiedMinor += bytesCopied;
-                s->oldGenSize += bytesCopied;
-                s->amInMinorGC = FALSE;
-                if (detailedGCTime (s))
-                        stopTiming (&ru_start, &s->ru_gcMinor);
-                if (DEBUG_GENERATIONAL or s->messages)
-                        fprintf (stderr, "Minor GC done.  %s bytes copied.\n",
-                                        uintToCommaString (bytesCopied));
-        }
-}
-
-/* ---------------------------------------------------------------- */
-/*                       Object hash consing                        */
-/* ---------------------------------------------------------------- */
-
-/* Hashing based on Introduction to Algorithms by Cormen Leiserson, and Rivest.
- * Section numbers in parens.
- * k is key to be hashed.
- * table is of size 2^p  (it must be a power of two)
- * Open addressing (12.4), meaning that we stick the entries directly in the 
- *   table and probe until we find what we want.
- * Multiplication method (12.3.2), meaning that we compute the hash by 
- *   multiplying by a magic number, chosen by Knuth, and take the high-order p
- *   bits of the low order 32 bits.
- * Double hashing (12.4), meaning that we use two hash functions, the first to
- *   decide where to start looking and a second to decide at what offset to
- *   probe.  The second hash must be relatively prime to the table size, which
- *   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 void destroyTable (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
-
-        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;
-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) {
-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;
-}
-
-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 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;
-
-        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;
-        }
-done:
-        if (DEBUG_SHARE)
-                fprintf (stderr, "0x%08x = hashCons (0x%08x)\n", 
-                                (uint)res, (uint)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); 
-}
-
-/* ---------------------------------------------------------------- */
-/*                       Depth-first Marking                        */
-/* ---------------------------------------------------------------- */
-
-static inline uint *arrayCounterp (pointer a) {
-        return ((uint*)a - 3);
-}
-
-static inline uint arrayCounter (pointer a) {
-        return *(arrayCounterp (a));
-}
-
-static inline bool isMarked (pointer p) {
-        return MARK_MASK & GC_getHeader (p);
-}
-
-static bool modeEqMark (MarkMode m, pointer p) {
-        return (MARK_MODE == m) ? isMarked (p): not isMarked (p);
-}
-
-/* mark (s, p, m) sets all the mark bits in the object graph pointed to by p. 
- * If m is MARK_MODE, it sets the bits to 1.
- * If m is UNMARK_MODE, it sets the bits to 0.
- *
- * It returns the total size in bytes of the objects marked.
- */
-W32 mark (GC_state s, pointer root, MarkMode mode, Bool shouldHashCons) {
-        uint arrayIndex;
-        pointer cur;  /* The current object being marked. */
-        GC_offsets frameOffsets;
-        Bool hasIdentity;
-        Header* headerp;
-        Header header;
-        uint index; /* The i'th pointer in the object (element) being marked. */
-        GC_frameLayout *layout;
-        Header mark; /* Used to set or clear the mark bit. */
-        pointer next; /* The next object to mark. */
-        Header *nextHeaderp;
-        Header nextHeader;
-        uint numNonPointers;
-        uint numPointers;
-        pointer prev; /* The previous object on the mark stack. */
-        W32 size; /* Total number of bytes marked. */
-        uint tag;
-        pointer todo; /* A pointer to the pointer in cur to next. */
-        pointer top; /* The top of the next stack frame to mark. */
-
-        if (modeEqMark (mode, root))
-                /* Object has already been marked. */
-                return 0;
-        mark = (MARK_MODE == mode) ? MARK_MASK : 0;
-        size = 0;
-        cur = root;
-        prev = NULL;
-        headerp = GC_getHeaderp (cur);
-        header = *(Header*)headerp;
-        goto mark;      
-markNext:
-        /* cur is the object that was being marked.
-         * prev is the mark stack.
-         * next is the unmarked object to be marked.
-         * nextHeaderp points to the header of next.
-         * nextHeader is the header of next.
-         * todo is a pointer to the pointer inside cur that points to next.
-         */
-        if (DEBUG_MARK_COMPACT)
-                fprintf (stderr, "markNext  cur = 0x%08x  next = 0x%08x  prev = 0x%08x  todo = 0x%08x\n",
-                                (uint)cur, (uint)next, (uint)prev, (uint)todo);
-        assert (not modeEqMark (mode, next));
-        assert (nextHeaderp == GC_getHeaderp (next));
-        assert (nextHeader == GC_getHeader (next));
-        assert (*(pointer*) todo == next);
-        headerp = nextHeaderp;
-        header = nextHeader;
-        *(pointer*)todo = prev;
-        prev = cur;
-        cur = next;
-mark:
-        if (DEBUG_MARK_COMPACT)
-                fprintf (stderr, "mark  cur = 0x%08x  prev = 0x%08x  mode = %s\n",
-                                (uint)cur, (uint)prev,
-                                (mode == MARK_MODE) ? "mark" : "unmark");
-        /* cur is the object to mark. 
-         * prev is the mark stack.
-         * headerp points to the header of cur.
-         * header is the header of cur.
-         */
-        assert (not modeEqMark (mode, cur));
-        assert (header == GC_getHeader (cur));
-        assert (headerp == GC_getHeaderp (cur));
-        header ^= 0x80000000;
-        /* Store the mark.  In the case of an object that contains a pointer to
-         * itself, it is essential that we store the marked header before marking
-         * the internal pointers (markInNormal below).  If we didn't, then we
-         * would see the object as unmarked and traverse it again.
-         */
-        *headerp = header;
-        SPLIT_HEADER();
-        if (NORMAL_TAG == tag) {
-                if (0 == numPointers) {
-                        /* There is nothing to mark. */
-                        size += GC_NORMAL_HEADER_SIZE + toBytes (numNonPointers);
-normalDone:
-                        if (shouldHashCons)
-                                cur = hashCons (s, cur, TRUE);
-                        goto ret;
-                }
-                todo = cur + toBytes (numNonPointers);
-                size += todo + toBytes (numPointers) - (pointer)headerp;
-                index = 0;
-markInNormal:
-                if (DEBUG_MARK_COMPACT)
-                        fprintf (stderr, "markInNormal  index = %d\n", index);
-                assert (index < numPointers);
-                next = *(pointer*)todo;
-                if (not GC_isPointer (next)) {
-markNextInNormal:
-                        assert (index < numPointers);
-                        index++;
-                        if (index == numPointers) {
-                                *headerp = header & ~COUNTER_MASK;
-                                goto normalDone;
-                        }
-                        todo += POINTER_SIZE;
-                        goto markInNormal;
-                }
-                nextHeaderp = GC_getHeaderp (next);
-                nextHeader = *nextHeaderp;
-                if (mark == (nextHeader & MARK_MASK)) {
-                        maybeSharePointer (s, (pointer*)todo, shouldHashCons);
-                        goto markNextInNormal;
-                }
-                *headerp = (header & ~COUNTER_MASK) |
-                                (index << COUNTER_SHIFT);
-                goto markNext;
-        } else if (WEAK_TAG == tag) {
-                /* Store the marked header and don't follow any pointers. */
-                goto ret;
-        } else if (ARRAY_TAG == tag) {
-                /* When marking arrays:
-                 *   arrayIndex is the index of the element to mark.
-                 *   cur is the pointer to the array.
-                 *   index is the index of the pointer within the element
-                 *     (i.e. the i'th pointer is at index i).
-                 *   todo is the start of the element.
-                 */
-                size += GC_ARRAY_HEADER_SIZE
-                        + arrayNumBytes (s, cur, numPointers, numNonPointers);
-                if (0 == numPointers or 0 == GC_arrayNumElements (cur)) {
-                        /* There is nothing to mark. */
-arrayDone:
-                        if (shouldHashCons)
-                                cur = hashCons (s, cur, TRUE);
-                        goto ret;
-                }
-                /* Begin marking first element. */
-                arrayIndex = 0;
-                todo = cur;
-markArrayElt:
-                assert (arrayIndex < GC_arrayNumElements (cur));
-                index = 0;
-                /* Skip to the first pointer. */
-                todo += numNonPointers;
-markInArray:
-                if (DEBUG_MARK_COMPACT)
-                        fprintf (stderr, "markInArray arrayIndex = %u index = %u\n",
-                                        arrayIndex, index);
-                assert (arrayIndex < GC_arrayNumElements (cur));
-                assert (index < numPointers);
-                assert (todo == arrayPointer (s, cur, arrayIndex, index));
-                next = *(pointer*)todo;
-                if (not (GC_isPointer (next))) {
-markNextInArray:
-                        assert (arrayIndex < GC_arrayNumElements (cur));
-                        assert (index < numPointers);
-                        assert (todo == arrayPointer (s, cur, arrayIndex, index));
-                        todo += POINTER_SIZE;
-                        index++;
-                        if (index < numPointers)
-                                goto markInArray;
-                        arrayIndex++;
-                        if (arrayIndex < GC_arrayNumElements (cur))
-                                goto markArrayElt;
-                        /* Done.  Clear out the counters and return. */
-                        *arrayCounterp (cur) = 0;
-                        *headerp = header & ~COUNTER_MASK;
-                        goto arrayDone;
-                }
-                nextHeaderp = GC_getHeaderp (next);
-                nextHeader = *nextHeaderp;
-                if (mark == (nextHeader & MARK_MASK)) {
-                        maybeSharePointer (s, (pointer*)todo, shouldHashCons);
-                        goto markNextInArray;
-                }
-                /* Recur and mark next. */
-                *arrayCounterp (cur) = arrayIndex;
-                *headerp = (header & ~COUNTER_MASK) |
-                                (index << COUNTER_SHIFT);
-                goto markNext;
-        } else {
-                assert (STACK_TAG == tag);
-                size += stackBytes (s, ((GC_stack)cur)->reserved);
-                top = stackTop (s, (GC_stack)cur);
-                assert (((GC_stack)cur)->used <= ((GC_stack)cur)->reserved);
-markInStack:
-                /* Invariant: top points just past the return address of the
-                 * frame to be marked.
-                 */
-                assert (stackBottom (s, (GC_stack)cur) <= top);
-                if (DEBUG_MARK_COMPACT)
-                        fprintf (stderr, "markInStack  top = %d\n",
-                                        top - stackBottom (s, (GC_stack)cur));
-                                        
-                if (top == stackBottom (s, (GC_stack)(cur)))
-                        goto ret;
-                index = 0;
-                layout = getFrameLayout (s, *(word*) (top - WORD_SIZE));
-                frameOffsets = layout->offsets;
-                ((GC_stack)cur)->markTop = top;
-markInFrame:
-                if (index == frameOffsets [0]) {
-                        top -= layout->numBytes;
-                        goto markInStack;
-                }
-                todo = top - layout->numBytes + frameOffsets [index + 1];
-                next = *(pointer*)todo;
-                if (DEBUG_MARK_COMPACT)
-                        fprintf (stderr, 
-                                "    offset %u  todo 0x%08x  next = 0x%08x\n", 
-                                frameOffsets [index + 1], 
-                                (uint)todo, (uint)next);
-                if (not GC_isPointer (next)) {
-                        index++;
-                        goto markInFrame;
-                }
-                nextHeaderp = GC_getHeaderp (next);
-                nextHeader = *nextHeaderp;
-                if (mark == (nextHeader & MARK_MASK)) {
-                        index++;
-                        maybeSharePointer (s, (pointer*)todo, shouldHashCons);
-                        goto markInFrame;
-                }
-                ((GC_stack)cur)->markIndex = index;             
-                goto markNext;
-        }
-        assert (FALSE);
-ret:
-        /* Done marking cur, continue with prev.
-         * Need to set the pointer in the prev object that pointed to cur 
-         * to point back to prev, and restore prev.
-         */
-        if (DEBUG_MARK_COMPACT)
-                fprintf (stderr, "return  cur = 0x%08x  prev = 0x%08x\n",
-                                (uint)cur, (uint)prev);
-        assert (modeEqMark (mode, cur));
-        if (NULL == prev)
-                return size;
-        next = cur;
-        cur = prev;
-        headerp = GC_getHeaderp (cur);
-        header = *headerp;
-        SPLIT_HEADER();
-        /* It's impossible to get a WEAK_TAG here, since we would never follow
-         * the weak object pointer.
-         */
-        assert (WEAK_TAG != tag);
-        if (NORMAL_TAG == tag) {
-                todo = cur + toBytes (numNonPointers);
-                index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
-                todo += index * POINTER_SIZE;
-                prev = *(pointer*)todo;
-                *(pointer*)todo = next;
-                goto markNextInNormal;
-        } else if (ARRAY_TAG == tag) {
-                arrayIndex = arrayCounter (cur);
-                todo = cur + arrayIndex * (numNonPointers 
-                                                + toBytes (numPointers));
-                index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
-                todo += numNonPointers + index * POINTER_SIZE;
-                prev = *(pointer*)todo;
-                *(pointer*)todo = next;
-                goto markNextInArray;
-        } else {
-                assert (STACK_TAG == tag);
-                index = ((GC_stack)cur)->markIndex;
-                top = ((GC_stack)cur)->markTop;
-                layout = getFrameLayout (s, *(word*) (top - WORD_SIZE));
-                frameOffsets = layout->offsets;
-                todo = top - layout->numBytes + frameOffsets [index + 1];
-                prev = *(pointer*)todo;
-                *(pointer*)todo = next;
-                index++;
-                goto markInFrame;
-        }
-        assert (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));
-}
-
-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);
-}
-
-/* ---------------------------------------------------------------- */
-/*                 Jonkers Mark-compact Collection                  */
-/* ---------------------------------------------------------------- */
-
-static inline void markGlobalTrue (GC_state s, pointer *pp) {
-        mark (s, *pp, MARK_MODE, TRUE);
-}
-
-static inline void markGlobalFalse (GC_state s, pointer *pp) {
-        mark (s, *pp, MARK_MODE, FALSE);
-}
-
-static inline void unmarkGlobal (GC_state s, pointer *pp) {
-        mark (s, *pp, UNMARK_MODE, FALSE);
-}
-
-static inline void threadInternal (GC_state s, pointer *pp) {
-        Header *headerp;
-
-        if (FALSE)
-                fprintf (stderr, "threadInternal pp = 0x%08x  *pp = 0x%08x  header = 0x%08x\n",
-                                (uint)pp, *(uint*)pp, (uint)GC_getHeader (*pp));
-        headerp = GC_getHeaderp (*pp);
-        *(Header*)pp = *headerp;
-        *headerp = (Header)pp;
-}
-
-/* If p is weak, the object pointer was valid, and points to an unmarked object,
- * then clear the object pointer.
- */
-static inline void maybeClearWeak (GC_state s, pointer p) {
-        Bool hasIdentity;
-        Header header;
-        Header *headerp;
-        uint numPointers;
-        uint numNonPointers;
-        uint tag;
-
-        headerp = GC_getHeaderp (p);
-        header = *headerp;
-        SPLIT_HEADER();
-        if (WEAK_TAG == tag and 1 == numPointers) { 
-                Header h2;
-
-                if (DEBUG_WEAK)
-                        fprintf (stderr, "maybeClearWeak (0x%08x)  header = 0x%08x\n",
-                                        (uint)p, (uint)header);
-                h2 = GC_getHeader (((GC_weak)p)->object);
-                /* If it's unmarked not threaded, clear the weak pointer. */
-                if (1 == ((MARK_MASK | 1) & h2)) {
-                        ((GC_weak)p)->object = (pointer)BOGUS_POINTER;
-                        header = WEAK_GONE_HEADER | MARK_MASK;
-                        if (DEBUG_WEAK)
-                                fprintf (stderr, "cleared.  new header = 0x%08x\n",
-                                                (uint)header);
-                        *headerp = header;
-                }
-        }
-}
-
-static void updateForwardPointers (GC_state s) {
-        pointer back;
-        pointer front;
-        uint gap;
-        pointer endOfLastMarked;
-        Header header;
-        Header *headerp;
-        pointer p;
-        uint size;
-
-        if (DEBUG_MARK_COMPACT)
-                fprintf (stderr, "Update forward pointers.\n");
-        front = alignFrontier (s, s->heap.start);
-        back = s->heap.start + s->oldGenSize;
-        endOfLastMarked = front;
-        gap = 0;
-updateObject:
-        if (DEBUG_MARK_COMPACT)
-                fprintf (stderr, "updateObject  front = 0x%08x  back = 0x%08x\n",
-                                (uint)front, (uint)back);
-        if (front == back)
-                goto done;
-        headerp = (Header*)front;
-        header = *headerp;
-        if (0 == header) {
-                /* We're looking at an array.  Move to the header. */
-                p = front + 3 * WORD_SIZE;
-                headerp = (Header*)(p - WORD_SIZE);
-                header = *headerp;
-        } else 
-                p = front + WORD_SIZE;
-        if (1 == (1 & header)) {
-                /* It's a header */
-                if (MARK_MASK & header) {
-                        /* It is marked, but has no forward pointers. 
-                         * Thread internal pointers.
-                         */
-thread:
-                        maybeClearWeak (s, p);
-                        size = objectSize (s, p);
-                        if (DEBUG_MARK_COMPACT)
-                                fprintf (stderr, "threading 0x%08x of size %u\n", 
-                                                (uint)p, size);
-                        if (front - endOfLastMarked >= 4 * WORD_SIZE) {
-                                /* Compress all of the unmarked into one string.
-                                 * We require 4 * WORD_SIZE space to be available
-                                 * because that is the smallest possible array.
-                                 * You cannot use 3 * WORD_SIZE because even
-                                 * zero-length arrays require an extra word for
-                                 * the forwarding pointer.  If you did use
-                                 * 3 * WORD_SIZE, updateBackwardPointersAndSlide
-                                 * would skip the extra word and be completely
-                                 * busted.
-                                 */
-                                if (DEBUG_MARK_COMPACT)
-                                        fprintf (stderr, "compressing from 0x%08x to 0x%08x (length = %u)\n",
-                                                        (uint)endOfLastMarked,
-                                                        (uint)front,
-                                                        front - endOfLastMarked);
-                                *(uint*)endOfLastMarked = 0;
-                                *(uint*)(endOfLastMarked + WORD_SIZE) = 
-                                        front - endOfLastMarked - 3 * WORD_SIZE;
-                                *(uint*)(endOfLastMarked + 2 * WORD_SIZE) =
-                                        GC_objectHeader (STRING_TYPE_INDEX);
-                        }
-                        front += size;
-                        endOfLastMarked = front;
-                        foreachPointerInObject (s, p, FALSE, threadInternal);
-                        goto updateObject;
-                } else {
-                        /* It's not marked. */
-                        size = objectSize (s, p);
-                        gap += size;
-                        front += size;
-                        goto updateObject;
-                }
-        } else {
-                pointer new;
-
-                assert (0 == (3 & header));
-                /* It's a pointer.  This object must be live.  Fix all the
-                 * forward pointers to it, store its header, then thread
-                 * its internal pointers.
-                 */
-                new = p - gap;
-                do {
-                        pointer cur;
-
-                        cur = (pointer)header;
-                        header = *(word*)cur;
-                        *(word*)cur = (word)new;
-                } while (0 == (1 & header));
-                *headerp = header;
-                goto thread;
-        }
-        assert (FALSE);
-done:
-        return;
-}
-
-static void updateBackwardPointersAndSlide (GC_state s) {
-        pointer back;
-        pointer front;
-        uint gap;
-        Header header;
-        pointer p;
-        uint size;
-
-        if (DEBUG_MARK_COMPACT)
-                fprintf (stderr, "Update backward pointers and slide.\n");
-        front = alignFrontier (s, s->heap.start);
-        back = s->heap.start + s->oldGenSize;
-        gap = 0;
-updateObject:
-        if (DEBUG_MARK_COMPACT)
-                fprintf (stderr, "updateObject  front = 0x%08x  back = 0x%08x\n",
-                                (uint)front, (uint)back);
-        if (front == back)
-                goto done;
-        header = *(word*)front;
-        if (0 == header) {
-                /* We're looking at an array.  Move to the header. */
-                p = front + 3 * WORD_SIZE;
-                header = *(Header*)(p - WORD_SIZE);
-        } else 
-                p = front + WORD_SIZE;
-        if (1 == (1 & header)) {
-                /* It's a header */
-                if (MARK_MASK & header) {
-                        /* It is marked, but has no backward pointers to it.
-                         * Unmark it.
-                         */
-unmark:
-                        *GC_getHeaderp (p) = header & ~MARK_MASK;
-                        size = objectSize (s, p);
-                        if (DEBUG_MARK_COMPACT)
-                                fprintf (stderr, "unmarking 0x%08x of size %u\n", 
-                                                (uint)p, size);
-                        /* slide */
-                        if (DEBUG_MARK_COMPACT)
-                                fprintf (stderr, "sliding 0x%08x down %u\n",
-                                                (uint)front, gap);
-                        copy (front, front - gap, size);
-                        front += size;
-                        goto updateObject;
-                } else {
-                        /* It's not marked. */
-                        size = objectSize (s, p);
-                        if (DEBUG_MARK_COMPACT)
-                                fprintf (stderr, "skipping 0x%08x of size %u\n",
-                                                (uint)p, size);
-                        gap += size;
-                        front += size;
-                        goto updateObject;
-                }
-        } else {
-                pointer new;
-
-                /* It's a pointer.  This object must be live.  Fix all the
-                 * backward pointers to it.  Then unmark it.
-                 */
-                new = p - gap;
-                do {
-                        pointer cur;
-
-                        assert (0 == (3 & header));
-                        cur = (pointer)header;
-                        header = *(word*)cur;
-                        *(word*)cur = (word)new;
-                } while (0 == (1 & header));
-                /* The header will be stored by unmark. */
-                goto unmark;
-        }
-        assert (FALSE);
-done:
-        s->oldGenSize = front - gap - s->heap.start;
-        if (DEBUG_MARK_COMPACT)
-                fprintf (stderr, "bytesLive = %u\n", s->bytesLive);
-        return;
-}
-
-static void markCompact (GC_state s) {
-        struct rusage ru_start;
-
-        if (DEBUG or s->messages)
-                fprintf (stderr, "Major mark-compact GC.\n");
-        if (detailedGCTime (s))
-                startTiming (&ru_start);
-        s->numMarkCompactGCs++;
-        if (s->hashConsDuringGC) {
-                s->bytesHashConsed = 0;
-                s->numHashConsGCs++;
-                s->objectHashTable = newTable (s);
-        }
-        foreachGlobal (s, s->hashConsDuringGC 
-                                ? markGlobalTrue 
-                                : markGlobalFalse);
-        if (s->hashConsDuringGC)
-                destroyTable (s->objectHashTable);
-        foreachGlobal (s, threadInternal);
-        updateForwardPointers (s);
-        updateBackwardPointersAndSlide (s);
-        clearCrossMap (s);
-        s->bytesMarkCompacted += s->oldGenSize;
-        s->lastMajor = GC_MARK_COMPACT;
-        if (detailedGCTime (s))
-                stopTiming (&ru_start, &s->ru_gcMarkCompact);
-        if (DEBUG or s->messages) {
-                fprintf (stderr, "Major mark-compact GC done.\n");
-                if (s->hashConsDuringGC)
-                        bytesHashConsedMessage 
-                                (s, s->bytesHashConsed + s->oldGenSize);
-        }
-}
-
-/* ---------------------------------------------------------------- */
-/*                          translateHeap                           */
-/* ---------------------------------------------------------------- */
-
-static void translatePointer (GC_state s, pointer *p) {
-        if (s->translateUp)
-                *p += s->translateDiff;
-        else
-                *p -= s->translateDiff;
-}
-
-/* Translate all pointers to the heap from within the stack and the heap for
- * a heap that has moved from from to to.
- */
-static void translateHeap (GC_state s, pointer from, pointer to, uint size) {
-        pointer limit;
-
-        if (DEBUG or s->messages)
-                fprintf (stderr, "Translating heap of size %s from 0x%08x to 0x%08x.\n",
-                                uintToCommaString (size),
-                                (uint)from, (uint)to);
-        if (from == to)
-                return;
-        else if (to > from) {
-                s->translateDiff = to - from;
-                s->translateUp = TRUE;
-        } else {
-                s->translateDiff = from - to;
-                s->translateUp = FALSE;
-        }
-        /* Translate globals and heap. */
-        foreachGlobal (s, translatePointer);
-        limit = to + size;
-        foreachPointerInRange (s, alignFrontier (s, to), &limit, FALSE,
-                                translatePointer);
-}
-
-/* ---------------------------------------------------------------- */
-/*                            heapRemap                             */
-/* ---------------------------------------------------------------- */
-
-bool heapRemap (GC_state s, GC_heap h, W32 desired, W32 minSize) {
-        W32 backoff;
-        W32 size;
-
-#if not HAS_REMAP
-        return FALSE;
-#endif
-        assert (minSize <= desired);
-        assert (desired >= h->size);
-        desired = align (desired, s->pageSize);
-        backoff = (desired - minSize) / 20;
-        if (0 == backoff)
-                backoff = 1; /* enough to terminate the loop below */
-        backoff = align (backoff, s->pageSize);
-        for (size = desired; size >= minSize; size -= backoff) {
-                pointer new;
-
-                new = remap (h->start, h->size, size);
-                unless ((void*)-1 == new) {
-                        h->start = new;
-                        h->size = size;
-                        if (h->size > s->maxHeapSizeSeen)
-                                s->maxHeapSizeSeen = h->size;
-                        assert (minSize <= h->size and h->size <= desired);
-                        return TRUE;
-                }
-        }
-        return FALSE;
-}
-
-/* ---------------------------------------------------------------- */
-/*                             heapGrow                             */
-/* ---------------------------------------------------------------- */
-
-static void growHeap (GC_state s, W32 desired, W32 minSize) {
-        GC_heap h;
-        struct GC_heap h2;
-        pointer old;
-        uint size;
-
-        h = &s->heap;
-        assert (desired >= h->size);
-        if (DEBUG_RESIZING)
-                fprintf (stderr, "Growing heap at 0x%08x of size %s to %s bytes.\n",
-                                (uint)h->start,
-                                uintToCommaString (h->size),
-                                uintToCommaString (desired));
-        old = s->heap.start;
-        size = s->oldGenSize;
-        assert (size <= h->size);
-        if (heapRemap (s, h, desired, minSize))
-                goto done;
-        heapShrink (s, h, size);
-        heapInit (&h2);
-        /* Allocate a space of the desired size. */
-        if (heapCreate (s, &h2, desired, minSize)) {
-                pointer from;
-                uint remaining;
-                pointer to;
-
-                from = old + size;
-                to = h2.start + size;
-                remaining = size;
-copy:                   
-                assert (remaining == from - old 
-                                and from >= old and to >= h2.start);
-                if (remaining < COPY_CHUNK_SIZE) {
-                        copy (old, h2.start, remaining);
-                } else {
-                        remaining -= COPY_CHUNK_SIZE;
-                        from -= COPY_CHUNK_SIZE;
-                        to -= COPY_CHUNK_SIZE;
-                        copy (from, to, COPY_CHUNK_SIZE);
-                        heapShrink (s, h, remaining);
-                        goto copy;
-                }
-                heapRelease (s, h);
-                *h = h2;
-        } else {
-                /* Write the heap to a file and try again. */
-                int fd;
-                FILE *stream;
-                char template[80];
-                char *tmpDefault;
-                char *tmpDir;
-                char *tmpVar;
-
-#if (defined (__MSVCRT__))
-                tmpVar = "TEMP";
-                tmpDefault = "C:/WINNT/TEMP";
-#else
-                tmpVar = "TMPDIR";
-                tmpDefault = "/tmp";
-#endif
-                tmpDir = getenv (tmpVar);
-                strcpy (template, (NULL == tmpDir) ? tmpDefault : tmpDir);
-                strcat (template, "/FromSpaceXXXXXX");
-                fd = smkstemp (template);
-                sclose (fd);
-                if (s->messages)
-                        fprintf (stderr, "Paging from space to %s.\n", 
-                                        template);
-                stream = sfopen (template, "wb");
-                sfwrite (old, 1, size, stream);
-                sfclose (stream);
-                heapRelease (s, h);
-                if (heapCreate (s, h, desired, minSize)) {
-                        stream = sfopen (template, "rb");
-                        sfread (h->start, 1, size, stream);
-                        sfclose (stream);
-                        sunlink (template);
-                } else {
-                        sunlink (template);
-                        if (s->messages)
-                                showMem ();
-                        die ("Out of memory.  Unable to allocate %s bytes.\n",
-                                uintToCommaString (minSize));
-                }
-        }
-done:
-        unless (old == s->heap.start) {
-                translateHeap (s, old, s->heap.start, s->oldGenSize);
-                setCardMapForMutator (s);
-        }
-}
-
-
-/* ---------------------------------------------------------------- */
-/*                     resizeCardMapAndCrossMap                     */
-/* ---------------------------------------------------------------- */
-
-static void resizeCardMapAndCrossMap (GC_state s) {
-        if (s->mutatorMarksCards 
-                and s->cardMapSize != 
-                        align (divCardSize (s, s->heap.size), s->pageSize)) {
-                pointer oldCardMap;
-                uchar *oldCrossMap;
-                uint oldCardMapSize;
-                uint oldCrossMapSize;
-
-                oldCardMap = s->cardMap;
-                oldCardMapSize = s->cardMapSize;
-                oldCrossMap = s->crossMap;
-                oldCrossMapSize = s->crossMapSize;
-                createCardMapAndCrossMap (s);
-                copy ((pointer)oldCrossMap, (pointer)s->crossMap,
-                        min (s->crossMapSize, oldCrossMapSize));
-                if (DEBUG_MEM)
-                        fprintf (stderr, "Releasing card/cross map.\n");
-                GC_release (oldCardMap, oldCardMapSize + oldCrossMapSize);
-        }
-}
-
-/* ---------------------------------------------------------------- */
-/*                            resizeHeap                            */
-/* ---------------------------------------------------------------- */
-/* Resize from space and to space, guaranteeing that at least 'need' bytes are
- * available in from space.
- */
-static void resizeHeap (GC_state s, W64 need) {
-        W32 desired;
-
-        if (DEBUG_RESIZING)
-                fprintf (stderr, "resizeHeap  need = %s fromSize = %s\n",
-                                ullongToCommaString (need), 
-                                uintToCommaString (s->heap.size));
-        desired = heapDesiredSize (s, need, s->heap.size);
-        assert (need <= desired);
-        if (desired <= s->heap.size)
-                heapShrink (s, &s->heap, desired);
-        else {
-                heapRelease (s, &s->heap2);
-                growHeap (s, desired, need);
-        }
-        resizeCardMapAndCrossMap (s);
-        assert (s->heap.size >= need);
-}
-
-/* Guarantee that heap2 is either the same size as heap or is unmapped. */
-static void resizeHeap2 (GC_state s) {
-        uint size;
-        uint size2;
-
-        size = s->heap.size;
-        size2 = s->heap2.size;
-        if (DEBUG_RESIZING)
-                fprintf (stderr, "resizeHeap2\n");
-        if (0 == size2)
-                return;
-        if (2 * size > s->ram)
-                /* Holding on to heap2 might cause paging.  So don't. */
-                heapRelease (s, &s->heap2);
-        else if (size2 < size) {
-                unless (heapRemap (s, &s->heap2, size, size))
-                        heapRelease (s, &s->heap2);
-        } else if (size2 > size)
-                heapShrink (s, &s->heap2, size);
-        assert (0 == s->heap2.size or s->heap.size == s->heap2.size);
-}
-
-static inline uint growStackSize (GC_state s) {
-        return max (2 * s->currentThread->stack->reserved, 
-                        stackNeedsReserved (s, s->currentThread->stack));
-}
-
-static void growStack (GC_state s) {
-        uint size;
-        GC_stack stack;
-
-        size = growStackSize (s);
-        if (DEBUG_STACKS or s->messages)
-                fprintf (stderr, "Growing stack to size %s.\n",
-                                uintToCommaString (stackBytes (s, size)));
-        assert (hasBytesFree (s, stackBytes (s, size), 0));
-        stack = newStack (s, size, TRUE);
-        stackCopy (s, s->currentThread->stack, stack);
-        s->currentThread->stack = stack;
-        markCard (s, (pointer)s->currentThread);
-}
-
-/* ---------------------------------------------------------------- */
-/*                        Garbage Collection                        */
-/* ---------------------------------------------------------------- */
-
-static bool heapAllocateSecondSemi (GC_state s, W32 size) {
-        if ((s->fixedHeap > 0 and s->heap.size + size > s->fixedHeap)
-                or (s->maxHeap > 0 and s->heap.size + size > s->maxHeap))
-                return FALSE;
-        return heapCreate (s, &s->heap2, size, s->oldGenSize);
-}
-
-static void majorGC (GC_state s, W32 bytesRequested, bool mayResize) {
-        s->numMinorsSinceLastMajor = 0;
-        if (0 < (s->numCopyingGCs + s->numMarkCompactGCs)
-                and ((float)s->numHashConsGCs 
-                        / (float)(s->numCopyingGCs + s->numMarkCompactGCs)
-                        < s->hashConsFrequency))
-                s->hashConsDuringGC = TRUE;
-        if ((not FORCE_MARK_COMPACT)
-                and not s->hashConsDuringGC // only markCompact can hash cons
-                and s->heap.size < s->ram
-                and (not heapIsInit (&s->heap2)
-                        or heapAllocateSecondSemi (s, heapDesiredSize (s, (W64)s->bytesLive + bytesRequested, 0))))
-                cheneyCopy (s);
-        else
-                markCompact (s);
-        s->hashConsDuringGC = FALSE;
-        s->bytesLive = s->oldGenSize;
-        if (s->bytesLive > s->maxBytesLive)
-                s->maxBytesLive = s->bytesLive;
-        /* Notice that the s->bytesLive below is different than the s->bytesLive
-         * used as an argument to heapAllocateSecondSemi above.  Above, it was 
-         * an estimate.  Here, it is exactly how much was live after the GC.
-         */
-        if (mayResize)
-                resizeHeap (s, (W64)s->bytesLive + bytesRequested);
-        resizeHeap2 (s);
-        assert (s->oldGenSize + bytesRequested <= s->heap.size);
-}
-
-static inline void enterGC (GC_state s) {
-        if (s->profilingIsOn) {
-                /* We don't need to profileEnter for count profiling because it
-                 * has already bumped the counter.  If we did allow the bump,
-                 * then the count would look like function(s) had run an extra
-                 * time.
-                 */  
-                if (s->profileStack and not (PROFILE_COUNT == s->profileKind))
-                        GC_profileEnter (s);
-                s->amInGC = TRUE;
-        }
-}
-
-static inline void leaveGC (GC_state s) {
-        if (s->profilingIsOn) {
-                if (s->profileStack and not (PROFILE_COUNT == s->profileKind))
-                        GC_profileLeave (s);
-                s->amInGC = FALSE;
-        }
-}
-
-static inline bool needGCTime (GC_state s) {
-        return DEBUG or s->summary or s->messages or s->rusageMeasureGC;
-}
-
-static void doGC (GC_state s, 
-                        W32 oldGenBytesRequested,
-                        W32 nurseryBytesRequested, 
-                        bool forceMajor,
-                        bool mayResize) {
-        uint gcTime;
-        bool stackTopOk;
-        W64 stackBytesRequested;
-        struct rusage ru_start;
-        W64 totalBytesRequested;
-        
-        enterGC (s);
-        if (DEBUG or s->messages)
-                fprintf (stderr, "Starting gc.  Request %s nursery bytes and %s old gen bytes.\n",
-                                uintToCommaString (nurseryBytesRequested),
-                                uintToCommaString (oldGenBytesRequested));
-        assert (invariant (s));
-        if (needGCTime (s))
-                startTiming (&ru_start);
-        minorGC (s);
-        stackTopOk = mutatorStackInvariant (s);
-        stackBytesRequested = 
-                stackTopOk ? 0 : stackBytes (s, growStackSize (s));
-        totalBytesRequested = 
-                (W64)oldGenBytesRequested 
-                + stackBytesRequested
-                + nurseryBytesRequested;
-        if (forceMajor 
-                or totalBytesRequested > s->heap.size - s->oldGenSize)
-                majorGC (s, totalBytesRequested, mayResize);
-        setNursery (s, oldGenBytesRequested + stackBytesRequested,
-                        nurseryBytesRequested);
-        assert (hasBytesFree (s, oldGenBytesRequested + stackBytesRequested,
-                                        nurseryBytesRequested));
-        unless (stackTopOk)
-                growStack (s);
-        setStack (s);
-        if (needGCTime (s)) {
-                gcTime = stopTiming (&ru_start, &s->ru_gc);
-                s->maxPause = max (s->maxPause, gcTime);
-        } else
-                gcTime = 0;  /* Assign gcTime to quell gcc warning. */
-        if (DEBUG or s->messages) {
-                fprintf (stderr, "Finished gc.\n");
-                fprintf (stderr, "time: %s ms\n", intToCommaString (gcTime));
-                fprintf (stderr, "old gen size: %s bytes (%.1f%%)\n", 
-                                intToCommaString (s->oldGenSize),
-                                100.0 * ((double) s->oldGenSize) 
-                                        / s->heap.size);
-        }
-        /* Send a GC signal. */
-        if (s->handleGCSignal and s->signalHandler != BOGUS_THREAD) {
-                if (DEBUG_SIGNALS)
-                        fprintf (stderr, "GC Signal pending.\n");
-                s->gcSignalIsPending = TRUE;
-                unless (s->inSignalHandler) 
-                        s->signalIsPending = TRUE;
-        }
-        if (DEBUG) 
-                GC_display (s, stderr);
-        assert (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
-        assert (invariant (s));
-        leaveGC (s);
-}
-
-static inline void ensureMutatorInvariant (GC_state s, bool force) {
-        if (force
-                or not (mutatorFrontierInvariant(s))
-                or not (mutatorStackInvariant(s))) {
-                /* This GC will grow the stack, if necessary. */
-                doGC (s, 0, s->currentThread->bytesNeeded, force, TRUE);
-        }
-        assert (mutatorFrontierInvariant(s));
-        assert (mutatorStackInvariant(s));
-}
-
-/* ensureFree (s, b) ensures that upon return
- *      b <= s->limitPlusSlop - s->frontier
- */
-static inline void ensureFree (GC_state s, uint b) {
-        assert (s->frontier <= s->limitPlusSlop);
-        if (b > s->limitPlusSlop - s->frontier)
-                doGC (s, 0, b, FALSE, TRUE);
-        assert (b <= s->limitPlusSlop - s->frontier);
-}
-
-static void switchToThread (GC_state s, GC_thread t) {
-        if (DEBUG_THREADS)
-                fprintf (stderr, "switchToThread (0x%08x)  used = %u  reserved = %u\n", 
-                                (uint)t, t->stack->used, t->stack->reserved);
-        s->currentThread = t;
-        setStack (s);
-}
-
-/* GC_startHandler does not do an enter()/leave(), even though it is exported.
- * The basis library uses it via _import, not _prim, and so does not treat it
- * as a runtime call -- so the invariant in enter would fail miserably.  It is
- * OK because GC_startHandler must be called from within a critical section.
- *
- * Don't make it inline, because it is also called in basis/Thread.c, and when
- * compiling with COMPILE_FAST, they may appear out of order.
- */
-void GC_startHandler (GC_state s) {
-        /* Switch to the signal handler thread. */
-        if (DEBUG_SIGNALS) {
-                fprintf (stderr, "switching to signal handler\n");
-                GC_display (s, stderr);
-        }
-        assert (s->canHandle == 1);
-        assert (s->signalIsPending);
-        s->signalIsPending = FALSE;
-        s->inSignalHandler = TRUE;
-        s->savedThread = s->currentThread;
-        /* Set s->canHandle to 2 when switching to the signal handler thread;
-         * leaving the runtime will decrement s->canHandle to 1,
-         * the signal handler will then run atomically and will finish by
-         * switching to the thread to continue with, which will decrement
-         * s->canHandle to 0.
-         */
-        s->canHandle = 2;
-}
-
-static inline void maybeSwitchToHandler (GC_state s) {
-        if (s->canHandle == 1 and s->signalIsPending) {
-                GC_startHandler (s);
-                switchToThread (s, s->signalHandler);
-        }
-}
-
-void GC_switchToThread (GC_state s, GC_thread t, uint ensureBytesFree) {
-        if (DEBUG_THREADS)
-                fprintf (stderr, "GC_switchToThread (0x%08x, %u)\n", (uint)t, ensureBytesFree);
-        if (FALSE) {
-                /* This branch is slower than the else branch, especially 
-                 * when debugging is turned on, because it does an invariant
-                 * check on every thread switch.
-                 * So, we'll stick with the else branch for now.
-                 */
-                enter (s);
-                s->currentThread->bytesNeeded = ensureBytesFree;
-                switchToThread (s, t);
-                s->canHandle--;
-                maybeSwitchToHandler (s);
-                ensureMutatorInvariant (s, FALSE);
-                assert (mutatorFrontierInvariant(s));
-                assert (mutatorStackInvariant(s));
-                leave (s);
-        } else {
-                /* BEGIN: enter(s); */
-                s->currentThread->stack->used = currentStackUsed (s);
-                s->currentThread->exnStack = s->exnStack;
-                atomicBegin (s);
-                /* END: enter(s); */
-                s->currentThread->bytesNeeded = ensureBytesFree;
-                switchToThread (s, t);
-                s->canHandle--;
-                maybeSwitchToHandler (s);
-                /* BEGIN: ensureMutatorInvariant */
-                if (not (mutatorFrontierInvariant(s))
-                        or not (mutatorStackInvariant(s))) {
-                        /* This GC will grow the stack, if necessary. */
-                        doGC (s, 0, s->currentThread->bytesNeeded, FALSE, TRUE);
-                } 
-                /* END: ensureMutatorInvariant */
-                /* BEGIN: leave(s); */
-                atomicEnd (s);
-                /* END: leave(s); */
-        }
-        assert (mutatorFrontierInvariant(s));
-        assert (mutatorStackInvariant(s));
-}
-
-void GC_gc (GC_state s, uint bytesRequested, bool force,
-                string file, int line) {
-        if (DEBUG or s->messages)
-                fprintf (stderr, "%s %d: GC_gc\n", file, line);
-        enter (s);
-        /* When the mutator requests zero bytes, it may actually need as much
-         * as LIMIT_SLOP.
-         */
-        if (0 == bytesRequested)
-                bytesRequested = LIMIT_SLOP;
-        s->currentThread->bytesNeeded = bytesRequested;
-        maybeSwitchToHandler (s);
-        ensureMutatorInvariant (s, force);
-        assert (mutatorFrontierInvariant(s));
-        assert (mutatorStackInvariant(s));
-        leave (s);
-}
-
-/* ---------------------------------------------------------------- */
-/*                         GC_arrayAllocate                         */
-/* ---------------------------------------------------------------- */
-
-pointer GC_arrayAllocate (GC_state s, W32 ensureBytesFree, W32 numElts, 
-                                W32 header) {
-        W64 arraySize64;
-        W32 arraySize;
-        uint eltSize;
-        W32 *frontier;
-        Bool hasIdentity;
-        Pointer last;
-        uint numPointers;
-        uint numNonPointers;
-        pointer res;
-        uint tag;
-
-        SPLIT_HEADER();
-        if (DEBUG)
-                fprintf (stderr, "GC_arrayAllocate (0x%08x, %u, %u, 0x%08x)\n",
-                                (uint)s, (uint)ensureBytesFree, 
-                                (uint)numElts, (uint)header);
-        eltSize = numPointers * POINTER_SIZE + numNonPointers;
-        arraySize64 = 
-                w64align ((W64)eltSize * (W64)numElts + GC_ARRAY_HEADER_SIZE,
-                                s->alignment);
-        if (arraySize64 >= 0x100000000llu)
-                die ("Out of memory: cannot allocate array with %s bytes.",
-                        ullongToCommaString (arraySize64));
-        arraySize = (W32)arraySize64;
-        if (arraySize < GC_ARRAY_HEADER_SIZE + WORD_SIZE)
-                /* Create space for forwarding pointer. */
-                arraySize = GC_ARRAY_HEADER_SIZE + WORD_SIZE;
-        if (DEBUG_ARRAY)
-                fprintf (stderr, "array with %s elts of size %u and total size %s.  Ensure %s bytes free.\n",
-                        uintToCommaString (numElts), 
-                        (uint)eltSize, 
-                        uintToCommaString (arraySize),
-                        uintToCommaString (ensureBytesFree));
-        if (arraySize >= s->oldGenArraySize) {
-                enter (s);
-                doGC (s,  arraySize, ensureBytesFree, FALSE, TRUE);
-                leave (s);
-                frontier = (W32*)(s->heap.start + s->oldGenSize);
-                last = (pointer)frontier + arraySize;
-                s->oldGenSize += arraySize;
-                s->bytesAllocated += arraySize;
-        } else {
-                W32 require;
-
-                require = arraySize + ensureBytesFree;
-                if (require > s->limitPlusSlop - s->frontier) {
-                        enter (s);
-                        doGC (s, 0, require, FALSE, TRUE);
-                        leave (s);
-                }
-                frontier = (W32*)s->frontier;
-                last = (pointer)frontier + arraySize;
-                assert (isAlignedFrontier (s, last));
-                s->frontier = last;
-        }
-        *frontier++ = 0; /* counter word */
-        *frontier++ = numElts;
-        *frontier++ = header;
-        res = (pointer)frontier;
-        /* Initialize all pointers with BOGUS_POINTER. */
-        if (1 <= numPointers and 0 < numElts) {
-                pointer p;
-
-                if (0 == numNonPointers)
-                        for (p = (pointer)frontier; 
-                                p < last; 
-                                p += POINTER_SIZE)
-                                *(Pointer*)p = (Pointer)BOGUS_POINTER;
-                else
-                        for (p = (Pointer)frontier; p < last; ) {
-                                pointer next;
-
-                                p += numNonPointers;
-                                next = p + numPointers * POINTER_SIZE;
-                                assert (next <= last);
-                                while (p < next) {
-                                        *(Pointer*)p = (Pointer)BOGUS_POINTER;
-                                        p += POINTER_SIZE;
-                                }       
-                        }
-        }
-        GC_profileAllocInc (s, arraySize);
-        if (DEBUG_ARRAY) {
-                fprintf (stderr, "GC_arrayAllocate done.  res = 0x%x  frontier = 0x%x\n",
-                                (uint)res, (uint)s->frontier);
-                GC_display (s, stderr);
-        }
-        assert (ensureBytesFree <= s->limitPlusSlop - s->frontier);
-        /* Unfortunately, the invariant isn't quite true here, because unless we
-         * did the GC, we never set s->currentThread->stack->used to reflect
-         * what the mutator did with stackTop.
-         */
-        return res;
-}       
-
-/* ---------------------------------------------------------------- */
-/*                             Threads                              */
-/* ---------------------------------------------------------------- */
-
-static inline uint threadBytes (GC_state s) {
-        uint res;
-
-        res = GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread);
-        /* The following assert depends on struct GC_thread being the right
-         * size.  Right now, it happens that res = 16, which is aligned mod 4
-         * and mod 8, which is all that we need.  If the struct every changes
-         * (possible) or we need more alignment (doubtful), we may need to put
-         * some padding at the beginning.
-         */
-        assert (isAligned (res, s->alignment));
-        return res;
-}
-
-static GC_thread newThreadOfSize (GC_state s, uint stackSize) {
-        GC_stack stack;
-        GC_thread t;
-
-        ensureFree (s, stackBytes (s, stackSize) + threadBytes (s));
-        stack = newStack (s, stackSize, FALSE);
-        t = (GC_thread) object (s, THREAD_HEADER, threadBytes (s), FALSE, FALSE);
-        t->bytesNeeded = 0;
-        t->exnStack = BOGUS_EXN_STACK;
-        t->stack = stack;
-        if (DEBUG_THREADS)
-                fprintf (stderr, "0x%x = newThreadOfSize (%u)\n",
-                                (uint)t, stackSize);;
-        return t;
-}
-
-static GC_thread copyThread (GC_state s, GC_thread from, uint size) {
-        GC_thread to;
-
-        if (DEBUG_THREADS)
-                fprintf (stderr, "copyThread (0x%08x)\n", (uint)from);
-        /* newThreadOfSize may do a GC, which invalidates from.  
-         * Hence we need to stash from where the GC can find it.
-         */
-        s->savedThread = from;
-        to = newThreadOfSize (s, size); 
-        from = s->savedThread;
-        s->savedThread = BOGUS_THREAD;
-        if (DEBUG_THREADS) {
-                fprintf (stderr, "free space = %u\n",
-                                s->limitPlusSlop - s->frontier);
-                fprintf (stderr, "0x%08x = copyThread (0x%08x)\n", 
-                                (uint)to, (uint)from);
-        }
-        stackCopy (s, from->stack, to->stack);
-        to->exnStack = from->exnStack;
-        return to;
-}
-
-void GC_copyCurrentThread (GC_state s) {
-        GC_thread res;
-        GC_thread t;
-        
-        if (DEBUG_THREADS)
-                fprintf (stderr, "GC_copyCurrentThread\n");
-        enter (s);
-        t = s->currentThread;
-        res = copyThread (s, t, t->stack->used);
-/* The following assert is no longer true, since alignment restrictions can force
- * the reserved to be slightly larger than the used.
- */
-/*      assert (res->stack->reserved == res->stack->used); */
-        assert (res->stack->reserved >= res->stack->used);
-        leave (s);
-        if (DEBUG_THREADS)
-                fprintf (stderr, "0x%08x = GC_copyCurrentThread\n", (uint)res);
-        s->savedThread = res;
-}
-
-pointer GC_copyThread (GC_state s, pointer thread) {
-        GC_thread res;
-        GC_thread t;
-
-        if (DEBUG_THREADS)
-                fprintf (stderr, "GC_copyThread (0x%08x)\n", (uint)thread);
-        enter (s);
-        t = (GC_thread)thread;
-/* The following assert is no longer true, since alignment restrictions can force
- * the reserved to be slightly larger than the used.
- */
-/*      assert (t->stack->reserved == t->stack->used); */
-        assert (t->stack->reserved >= t->stack->used);
-        res = copyThread (s, t, t->stack->used);
-/* The following assert is no longer true, since alignment restrictions can force
- * the reserved to be slightly larger than the used.
- */
-/*      assert (res->stack->reserved == res->stack->used); */
-        assert (res->stack->reserved >= res->stack->used);
-        leave (s);
-        if (DEBUG_THREADS)
-                fprintf (stderr, "0x%08x = GC_copyThread (0x%08x)\n", (uint)res, (uint)thread);
-        return (pointer)res;
-}
-
-/* ---------------------------------------------------------------- */
-/*                            Profiling                             */
-/* ---------------------------------------------------------------- */
-
-/* Apply f to the frame index of each frame in the current thread's stack. */
-void GC_foreachStackFrame (GC_state s, void (*f) (GC_state s, uint i)) {
-        pointer bottom;
-        word index;
-        GC_frameLayout *layout;
-        word returnAddress;
-        pointer top;
-
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "walking stack");
-        bottom = stackBottom (s, s->currentThread->stack);
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "  bottom = 0x%08x  top = 0x%08x.\n",
-                                (uint)bottom, (uint)s->stackTop);
-        for (top = s->stackTop; top > bottom; top -= layout->numBytes) {
-                returnAddress = *(word*)(top - WORD_SIZE);
-                index = getFrameIndex (s, returnAddress);
-                if (DEBUG_PROFILE)
-                        fprintf (stderr, "top = 0x%08x  index = %u\n",
-                                        (uint)top, index);
-                unless (0 <= index and index < s->frameLayoutsSize)
-                        die ("top = 0x%08x  returnAddress = 0x%08x  index = %u\n",
-                                        (uint)top, returnAddress, index);
-                f (s, index);
-                layout = &(s->frameLayouts[index]);
-                assert (layout->numBytes > 0);
-        }
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "done walking stack\n");
-}
-
-static int numStackFrames;
-static int *callStack;
-
-static void addToCallStack (GC_state s, uint i) {
-        if (DEBUG_CALL_STACK)
-                fprintf (stderr, "addToCallStack (%u)\n", i);
-        callStack[numStackFrames] = i;
-        numStackFrames++;
-}
-
-void GC_callStack (GC_state s, Pointer p) {
-        if (DEBUG_CALL_STACK)
-                fprintf (stderr, "GC_callStack\n");
-        numStackFrames = 0;
-        callStack = (int*)p;
-        GC_foreachStackFrame (s, addToCallStack);
-}
-
-uint * GC_frameIndexSourceSeq (GC_state s, int frameIndex) {
-        uint *res;
-
-        res = s->sourceSeqs[s->frameSources[frameIndex]];
-        if (DEBUG_CALL_STACK)
-                fprintf (stderr, "0x%08x = GC_frameIndexSourceSeq (%u)\n",
-                                (uint)res, frameIndex);
-        return res;
-}
-
-static void bumpStackFrameCount (GC_state s, uint i) {
-        numStackFrames++;
-}
-
-int GC_numStackFrames (GC_state s) {
-        numStackFrames = 0;
-        GC_foreachStackFrame (s, bumpStackFrameCount);
-        if (DEBUG_CALL_STACK)
-                fprintf (stderr, "%u = GC_numStackFrames\n", numStackFrames);
-        return numStackFrames;
-}
-
-inline string GC_sourceName (GC_state s, uint i) {
-        if (i < s->sourcesSize)
-                return s->sourceNames[s->sources[i].nameIndex];
-        else
-                return s->sourceNames[i - s->sourcesSize];
-}
-
-static inline GC_profileStack profileStackInfo (GC_state s, uint i) {
-        assert (s->profile != NULL);
-        return &(s->profile->stack[i]);
-}
-
-static inline uint profileMaster (GC_state s, uint i) {
-        return s->sources[i].nameIndex + s->sourcesSize;
-}
-
-static inline void removeFromStack (GC_state s, uint i) {
-        GC_profile p;
-        GC_profileStack ps;
-        ullong totalInc;
-
-        p = s->profile;
-        ps = profileStackInfo (s, i);
-        totalInc = p->total - ps->lastTotal;
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "removing %s from stack  ticksInc = %llu  ticksInGCInc = %llu\n",
-                                GC_sourceName (s, i), totalInc,
-                                p->totalGC - ps->lastTotalGC);
-        ps->ticks += totalInc;
-        ps->ticksInGC += p->totalGC - ps->lastTotalGC;
-}
-
-static void setProfTimer (long usec) {
-        struct itimerval iv;
-
-        iv.it_interval.tv_sec = 0;
-        iv.it_interval.tv_usec = usec;
-        iv.it_value.tv_sec = 0;
-        iv.it_value.tv_usec = usec;
-        unless (0 == setitimer (ITIMER_PROF, &iv, NULL))
-                die ("setProfTimer failed");
-}
-
-void GC_profileDone (GC_state s) {
-        GC_profile p;
-        uint sourceIndex;
-
-        if (DEBUG_PROFILE) 
-                fprintf (stderr, "GC_profileDone ()\n");
-        assert (s->profilingIsOn);
-        if (PROFILE_TIME == s->profileKind)
-                setProfTimer (0);
-        s->profilingIsOn = FALSE;
-        p = s->profile;
-        if (s->profileStack) {
-                for (sourceIndex = 0; 
-                        sourceIndex < s->sourcesSize + s->sourceNamesSize;
-                        ++sourceIndex) {
-                        if (p->stack[sourceIndex].numOccurrences > 0) {
-                                if (DEBUG_PROFILE)
-                                        fprintf (stderr, "done leaving %s\n", 
-                                                        GC_sourceName (s, sourceIndex));
-                                removeFromStack (s, sourceIndex);
-                        }
-                }
-        }
-}
-
-static int profileDepth = 0;
-
-static void profileIndent () {
-        int i;
-
-        for (i = 0; i < profileDepth; ++i)
-                fprintf (stderr, " ");
-}
-
-static inline void profileEnterSource (GC_state s, uint i) {
-        GC_profile p;
-        GC_profileStack ps;
-
-        p = s->profile;
-        ps = profileStackInfo (s, i);
-        if (0 == ps->numOccurrences) {
-                ps->lastTotal = p->total;
-                ps->lastTotalGC = p->totalGC;
-        }
-        ps->numOccurrences++;
-}
-
-static void profileEnter (GC_state s, uint sourceSeqIndex) {
-        int i;
-        GC_profile p;
-        uint sourceIndex;
-        uint *sourceSeq;
-
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "profileEnter (%u)\n", sourceSeqIndex);
-        assert (s->profileStack);
-        assert (sourceSeqIndex < s->sourceSeqsSize);
-        p = s->profile;
-        sourceSeq = s->sourceSeqs[sourceSeqIndex];
-        for (i = 1; i <= sourceSeq[0]; ++i) {
-                sourceIndex = sourceSeq[i];
-                if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
-                        profileIndent ();
-                        fprintf (stderr, "(entering %s\n", 
-                                        GC_sourceName (s, sourceIndex));
-                        profileDepth++;
-                }
-                profileEnterSource (s, sourceIndex);
-                profileEnterSource (s, profileMaster (s, sourceIndex));
-        }
-}
-
-static void enterFrame (GC_state s, uint i) {
-        profileEnter (s, s->frameSources[i]);
-}
-
-static inline void profileLeaveSource (GC_state s, uint i) {
-        GC_profile p;
-        GC_profileStack ps;
-
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "profileLeaveSource (%u)\n", i);
-        p = s->profile;
-        ps = profileStackInfo (s, i);
-        assert (ps->numOccurrences > 0);
-        ps->numOccurrences--;
-        if (0 == ps->numOccurrences)
-                removeFromStack (s, i);
-}
-
-static void profileLeave (GC_state s, uint sourceSeqIndex) {
-        int i;
-        GC_profile p;
-        uint sourceIndex;
-        uint *sourceSeq;
-
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "profileLeave (%u)\n", sourceSeqIndex);
-        assert (s->profileStack);
-        assert (sourceSeqIndex < s->sourceSeqsSize);
-        p = s->profile;
-        sourceSeq = s->sourceSeqs[sourceSeqIndex];
-        for (i = sourceSeq[0]; i > 0; --i) {
-                sourceIndex = sourceSeq[i];
-                if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
-                        profileDepth--;
-                        profileIndent ();
-                        fprintf (stderr, "leaving %s)\n",
-                                        GC_sourceName (s, sourceIndex));
-                }
-                profileLeaveSource (s, sourceIndex);
-                profileLeaveSource (s, profileMaster (s, sourceIndex));
-        }
-}
-
-static inline void profileInc (GC_state s, W32 amount, uint sourceSeqIndex) {
-        uint *sourceSeq;
-        uint topSourceIndex;
-
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "profileInc (%u, %u)\n", 
-                                (uint)amount, sourceSeqIndex);
-        assert (sourceSeqIndex < s->sourceSeqsSize);
-        sourceSeq = s->sourceSeqs[sourceSeqIndex];
-        topSourceIndex = sourceSeq[0] > 0
-                ? sourceSeq[sourceSeq[0]]
-                : SOURCES_INDEX_UNKNOWN;
-        if (DEBUG_PROFILE) {
-                profileIndent ();
-                fprintf (stderr, "bumping %s by %u\n",
-                                GC_sourceName (s, topSourceIndex), (uint)amount);
-        }
-        s->profile->countTop[topSourceIndex] += amount;
-        s->profile->countTop[profileMaster (s, topSourceIndex)] += amount;
-        if (s->profileStack)
-                profileEnter (s, sourceSeqIndex);
-        if (SOURCES_INDEX_GC == topSourceIndex)
-                s->profile->totalGC += amount;
-        else
-                s->profile->total += amount;
-        if (s->profileStack)
-                profileLeave (s, sourceSeqIndex);
-}
-
-void GC_profileEnter (GC_state s) {
-        profileEnter (s, topFrameSourceSeqIndex (s));
-}
-
-void GC_profileLeave (GC_state s) {
-        profileLeave (s, topFrameSourceSeqIndex (s));
-}
-
-void GC_profileInc (GC_state s, W32 amount) {
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "GC_profileInc (%u)\n", (uint)amount);
-        profileInc (s, amount, 
-                         s->amInGC
-                                ? SOURCE_SEQ_GC 
-                                : topFrameSourceSeqIndex (s));
-}
-
-void GC_profileAllocInc (GC_state s, W32 amount) {
-        if (s->profilingIsOn and (PROFILE_ALLOC == s->profileKind)) {
-                if (DEBUG_PROFILE)
-                        fprintf (stderr, "GC_profileAllocInc (%u)\n", (uint)amount);
-                GC_profileInc (s, amount);
-        }
-}
-
-static void showProf (GC_state s) {
-        int i;
-        int j;
-
-        fprintf (stdout, "0x%08x\n", s->magic);
-        fprintf (stdout, "%u\n", s->sourceNamesSize);
-        for (i = 0; i < s->sourceNamesSize; ++i)
-                fprintf (stdout, "%s\n", s->sourceNames[i]);
-        fprintf (stdout, "%u\n", s->sourcesSize);
-        for (i = 0; i < s->sourcesSize; ++i)
-                fprintf (stdout, "%u %u\n", 
-                                s->sources[i].nameIndex,
-                                s->sources[i].successorsIndex);
-        fprintf (stdout, "%u\n", s->sourceSeqsSize);
-        for (i = 0; i < s->sourceSeqsSize; ++i) {
-                uint *sourceSeq;
-
-                sourceSeq = s->sourceSeqs[i];
-                for (j = 1; j <= sourceSeq[0]; ++j)
-                        fprintf (stdout, "%u ", sourceSeq[j]);
-                fprintf (stdout, "\n");
-        }
-}
-
-GC_profile GC_profileNew (GC_state s) {
-        GC_profile p;
-        uint size;
-
-        NEW (GC_profile, p);
-        p->total = 0;
-        p->totalGC = 0;
-        size = s->sourcesSize + s->sourceNamesSize;
-        ARRAY (ullong*, p->countTop, size);
-        if (s->profileStack)
-                ARRAY (struct GC_profileStack *, p->stack, size);
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "0x%08x = GC_profileNew ()\n", (uint)p);
-        return p;
-}
-
-void GC_profileFree (GC_state s, GC_profile p) {
-        free (p->countTop);
-        if (s->profileStack)
-                free (p->stack);
-        free (p);
-}
-
-static void writeString (int fd, string s) {
-        swrite (fd, s, strlen(s));
-}
-
-static void writeUint (int fd, uint u) {
-        char buf[20];
-
-        sprintf (buf, "%u", u);
-        writeString (fd, buf);
-}
-
-static void writeUllong (int fd, ullong u) {
-        char buf[20];
-
-        sprintf (buf, "%llu", u);
-        writeString (fd, buf);
-}
-
-static void writeWord (int fd, word w) {
-        char buf[20];
-
-        sprintf (buf, "0x%08x", w);
-        writeString (fd, buf);
-}
-
-static inline void newline (int fd) {
-        writeString (fd, "\n");
-}
-
-static void profileWriteCount (GC_state s, GC_profile p, int fd, uint i) {
-        writeUllong (fd, p->countTop[i]);
-        if (s->profileStack) {
-                GC_profileStack ps;
-        
-                ps = &(p->stack[i]);
-                writeString (fd, " ");
-                writeUllong (fd, ps->ticks);
-                writeString (fd, " ");
-                writeUllong (fd, ps->ticksInGC);
-        }
-        newline (fd);
-}
-
-void GC_profileWrite (GC_state s, GC_profile p, int fd) {
-        int i;
-        string kind;
-
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "GC_profileWrite\n");
-        writeString (fd, "MLton prof\n");
-        kind = "";
-        switch (s->profileKind) {
-        case PROFILE_ALLOC:
-                kind = "alloc\n";
-        break;
-        case PROFILE_COUNT:
-                kind = "count\n";
-        break;
-        case PROFILE_NONE:
-                die ("impossible PROFILE_NONE");
-        break;
-        case PROFILE_TIME:
-                kind = "time\n";
-        break;
-        }
-        writeString (fd, kind);
-        writeString (fd, s->profileStack 
-                                ? "stack\n" : "current\n");
-        writeWord (fd, s->magic);
-        newline (fd);
-        writeUllong (fd, p->total);
-        writeString (fd, " ");
-        writeUllong (fd, p->totalGC);
-        newline (fd);
-        writeUint (fd, s->sourcesSize);
-        newline (fd);
-        for (i = 0; i < s->sourcesSize; ++i)
-                profileWriteCount (s, p, fd, i);
-        writeUint (fd, s->sourceNamesSize);
-        newline (fd);
-        for (i = 0; i < s->sourceNamesSize; ++i)
-                profileWriteCount (s, p, fd, i + s->sourcesSize);
-}
-
-#if not HAS_TIME_PROFILING
-
-/* No time profiling on this platform.  There is a check in mlton/main/main.fun
- * to make sure that time profiling is never turned on.
- */
-static void profileTimeInit (GC_state s) {
-        die ("no time profiling");
-}
-
-#else
-
-static GC_state catcherState;
-
-void GC_handleSigProf (pointer pc) {
-        uint frameIndex;
-        GC_state s;
-        uint sourceSeqIndex;
-
-        s = catcherState;
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "GC_handleSigProf (0x%08x)\n", (uint)pc);
-        if (s->amInGC)
-                sourceSeqIndex = SOURCE_SEQ_GC;
-        else {
-                frameIndex = topFrameIndex (s);
-                if (s->frameLayouts[frameIndex].isC)
-                        sourceSeqIndex = s->frameSources[frameIndex];
-                else {
-                        if (s->textStart <= pc and pc < s->textEnd)
-                                sourceSeqIndex = s->textSources [pc - s->textStart];
-                        else {
-                                if (DEBUG_PROFILE)
-                                        fprintf (stderr, "pc out of bounds\n");
-                                sourceSeqIndex = SOURCE_SEQ_UNKNOWN;
-                        }
-                }
-        }
-        profileInc (s, 1, sourceSeqIndex);
-}
-
-static int compareProfileLabels (const void *v1, const void *v2) {
-        GC_profileLabel l1;
-        GC_profileLabel l2;
-
-        l1 = (GC_profileLabel)v1;
-        l2 = (GC_profileLabel)v2;
-        return (int)l1->label - (int)l2->label;
-}
-
-static void profileTimeInit (GC_state s) {
-        int i;
-        pointer p;
-        struct sigaction sa;
-        uint sourceSeqsIndex;
-
-        s->profile = GC_profileNew (s);
-        /* Sort sourceLabels by address. */
-        qsort (s->sourceLabels, s->sourceLabelsSize, sizeof (*s->sourceLabels),
-                compareProfileLabels);
-        if (0 == s->sourceLabels[s->sourceLabelsSize - 1].label)
-                die ("Max profile label is 0 -- something is wrong.");
-        if (DEBUG_PROFILE)
-                for (i = 0; i < s->sourceLabelsSize; ++i)
-                        fprintf (stderr, "0x%08x  %u\n",
-                                        (uint)s->sourceLabels[i].label,
-                                        s->sourceLabels[i].sourceSeqsIndex);
-        if (ASSERT)
-                for (i = 1; i < s->sourceLabelsSize; ++i)
-                        assert (s->sourceLabels[i-1].label
-                                <= s->sourceLabels[i].label);
-        /* Initialize s->textSources. */
-        s->textEnd = (pointer)(getTextEnd());
-        s->textStart = (pointer)(getTextStart());
-        if (ASSERT)
-                for (i = 0; i < s->sourceLabelsSize; ++i) {
-                        pointer label;
-
-                        label = s->sourceLabels[i].label;
-                        assert (0 == label
-                                or (s->textStart <= label 
-                                        and label < s->textEnd));
-                }
-        ARRAY (uint*, s->textSources, s->textEnd - s->textStart);
-        p = s->textStart;
-        sourceSeqsIndex = SOURCE_SEQ_UNKNOWN;
-        for (i = 0; i < s->sourceLabelsSize; ++i) {
-                for ( ; p < s->sourceLabels[i].label; ++p)
-                        s->textSources[p - s->textStart] = sourceSeqsIndex;
-                sourceSeqsIndex = s->sourceLabels[i].sourceSeqsIndex;
-        }
-        for ( ; p < s->textEnd; ++p)
-                s->textSources[p - s->textStart] = sourceSeqsIndex;
-        /*
-         * Install catcher, which handles SIGPROF and calls MLton_Profile_inc.
-         * 
-         * One thing I should point out that I discovered the hard way: If
-         * the call to sigaction does NOT specify the SA_ONSTACK flag, then
-         * even if you have called sigaltstack(), it will NOT switch stacks,
-         * so you will probably die.  Worse, if the call to sigaction DOES
-         * have SA_ONSTACK and you have NOT called sigaltstack(), it still
-         * switches stacks (to location 0) and you die of a SEGV.  Thus the
-         * sigaction() call MUST occur after the call to sigaltstack(), and
-         * in order to have profiling cover as much as possible, you want it
-         * to occur right after the sigaltstack() call.
-         */
-        catcherState = s;
-        sigemptyset (&sa.sa_mask);
-        setSigProfHandler (&sa);
-        unless (sigaction (SIGPROF, &sa, NULL) == 0)
-                diee ("sigaction() failed");
-        /* Start the SIGPROF timer. */
-        setProfTimer (10000);
-}
-
-#endif
-
-/* profileEnd is for writing out an mlmon.out file even if the C code terminates
- * abnormally, e.g. due to running out of memory.  It will only run if the usual
- * SML profile atExit cleanup code did not manage to run.
- */
-static GC_state profileEndState;
-
-static void profileEnd () {
-        int fd;
-        GC_state s;
-
-        if (DEBUG_PROFILE)
-                fprintf (stderr, "profileEnd ()\n");
-        s = profileEndState;
-        if (s->profilingIsOn) {
-                fd = creat ("mlmon.out", 0666);
-                if (fd < 0)
-                        diee ("Cannot create mlmon.out");
-                GC_profileWrite (s, s->profile, fd);
-        }
-}
-
-/* ---------------------------------------------------------------- */
-/*                          Initialization                          */
-/* ---------------------------------------------------------------- */
-
-static void initSignalStack (GC_state s) {
-#if HAS_SIGALTSTACK
-        static stack_t altstack;
-        size_t ss_size = align (SIGSTKSZ, s->pageSize);
-        size_t psize = s->pageSize;
-        void *ss_sp = ssmmap (2 * ss_size, psize, psize);
-        altstack.ss_sp = ss_sp + ss_size;
-        altstack.ss_size = ss_size;
-        altstack.ss_flags = 0;
-        sigaltstack (&altstack, NULL);
-#endif
-}
-
-#if FALSE
-static bool stringToBool (string s) {
-        if (0 == strcmp (s, "false"))
-                return FALSE;
-        if (0 == strcmp (s, "true"))
-                return TRUE;
-        die ("Invalid @MLton bool: %s.", s);
-}
-#endif
-
-static float stringToFloat (string s) {
-        float f;
-
-        unless (1 == sscanf (s, "%f", &f))
-                die ("Invalid @MLton float: %s.", s);
-        return f;
-}
-
-static uint stringToBytes (string s) {
-        double d;
-        char *endptr;
-        uint factor;
-        
-        d = strtod (s, &endptr);
-        if (0.0 == d and s == endptr)
-                goto bad;
-        switch (*endptr++) {
-        case 'g':
-        case 'G':
-                factor = 1024 * 1024 * 1024;
-        break;
-        case 'k':
-        case 'K':
-                factor = 1024;
-        break;
-        case 'm':
-        case 'M':
-                factor = 1024 * 1024;
-        break;
-        default:
-                goto bad;
-        }
-        d *= factor;
-        unless (strlen (s) == endptr - s
-                        and (double)INT_MIN <= d 
-                        and d <= (double)INT_MAX)
-                goto bad;
-        return (uint)d;
-bad:
-        die ("Invalid @MLton memory amount: %s.", s);
-}
-
-static void setInitialBytesLive (GC_state s) {
-        int i;
-        int numBytes;
-        int numElements;
-
-        s->bytesLive = 0;
-        for (i = 0; i < s->intInfInitsSize; ++i) {
-                numElements = strlen (s->intInfInits[i].mlstr);
-                s->bytesLive +=
-                        align (GC_ARRAY_HEADER_SIZE 
-                                + WORD_SIZE // for the sign
-                                + numElements,
-                                s->alignment);
-        }
-        for (i = 0; i < s->vectorInitsSize; ++i) {
-                numBytes = s->vectorInits[i].bytesPerElement
-                        * s->vectorInits[i].numElements;
-                s->bytesLive +=
-                        align (GC_ARRAY_HEADER_SIZE
-                                + ((0 == numBytes) 
-                                        ? POINTER_SIZE
-                                        : numBytes),
-                                s->alignment);
-        }
-}
-
-/*
- * For each entry { globalIndex, mlstr } in the inits array (which is terminated
- * by one with an mlstr of NULL), set
- *      state->globals[globalIndex]
- * to the corresponding IntInf.int value.
- * On exit, the GC_state pointed to by s is adjusted to account for any
- * space used.
- */
-static void initIntInfs (GC_state s) {
-        struct GC_intInfInit *inits;
-        pointer frontier;
-        char    *str;
-        uint    slen,
-                llen,
-                alen,
-                i,
-                index;
-        bool    neg,
-                hex;
-        bignum  *bp;
-        uchar   *cp;
-
-        assert (isAlignedFrontier (s, s->frontier));
-        frontier = s->frontier;
-        for (index = 0; index < s->intInfInitsSize; ++index) {
-                inits = &s->intInfInits[index];
-                str = inits->mlstr;
-                assert (inits->globalIndex < s->globalsSize);
-                neg = *str == '~';
-                if (neg)
-                        ++str;
-                slen = strlen (str);
-                hex = str[0] == '0' && str[1] == 'x';
-                if (hex) {
-                        str += 2;
-                        slen -= 2;
-                        llen = (slen + 7) / 8;
-                } else
-                        llen = (slen + 8) / 9;
-                assert (slen > 0);
-                bp = (bignum *)frontier;
-                cp = (uchar *)&bp->limbs[llen];
-                for (i = 0; i != slen; ++i)
-                        if ('0' <= str[i] && str[i] <= '9')
-                                cp[i] = str[i] - '0' + 0;
-                        else if ('a' <= str[i] && str[i] <= 'f')
-                                cp[i] = str[i] - 'a' + 0xa;
-                        else {
-                                assert('A' <= str[i] && str[i] <= 'F');
-                                cp[i] = str[i] - 'A' + 0xA;
-                        }
-                alen = mpn_set_str (bp->limbs, cp, slen, hex ? 0x10 : 10);
-                assert (alen <= llen);
-                if (alen <= 1) {
-                        uint    val,
-                                ans;
-
-                        if (alen == 0)
-                                val = 0;
-                        else
-                                val = bp->limbs[0];
-                        if (neg) {
-                                /*
-                                 * We only fit if val in [1, 2^30].
-                                 */
-                                ans = - val;
-                                val = val - 1;
-                        } else
-                                /*
-                                 * We only fit if val in [0, 2^30 - 1].
-                                 */
-                                ans = val;
-                        if (val < (uint)1<<30) {
-                                s->globals[inits->globalIndex] = 
-                                        (pointer)(ans<<1 | 1);
-                                continue;
-                        }
-                }
-                s->globals[inits->globalIndex] = (pointer)&bp->isneg;
-                bp->counter = 0;
-                bp->card = alen + 1;
-                bp->magic = BIGMAGIC;
-                bp->isneg = neg;
-                frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
-        }
-        assert (isAlignedFrontier (s, frontier));
-        s->frontier = frontier;
-        GC_profileAllocInc (s, frontier - s->frontier);
-        s->bytesAllocated += frontier - s->frontier;
-}
-
-static void initStrings (GC_state s) {
-        struct GC_vectorInit *inits;
-        pointer frontier;
-        int i;
-
-        assert (isAlignedFrontier (s, s->frontier));
-        inits = s->vectorInits;
-        frontier = s->frontier;
-        for (i = 0; i < s->vectorInitsSize; ++i) {
-                uint bytesPerElement;
-                uint numBytes;
-                uint objectSize;
-                uint typeIndex;
-
-                bytesPerElement = inits[i].bytesPerElement;
-                numBytes = bytesPerElement * inits[i].numElements;
-                objectSize = align (GC_ARRAY_HEADER_SIZE
-                                        + ((0 == numBytes) 
-                                                ? POINTER_SIZE
-                                                : numBytes),
-                                        s->alignment);
-                assert (objectSize <= s->heap.start + s->heap.size - frontier);
-                *(word*)frontier = 0; /* counter word */
-                *(word*)(frontier + WORD_SIZE) = inits[i].numElements;
-                switch (bytesPerElement) {
-                case 1:
-                        typeIndex = WORD8_VECTOR_TYPE_INDEX;
-                break;
-                case 2:
-                        typeIndex = WORD16_VECTOR_TYPE_INDEX;
-                break;
-                case 4:
-                        typeIndex = WORD32_VECTOR_TYPE_INDEX;
-                break;
-                default:
-                        die ("unknown bytes per element in vectorInit: %d",
-                                bytesPerElement);
-                }
-                *(word*)(frontier + 2 * WORD_SIZE) = GC_objectHeader (typeIndex);
-                s->globals[inits[i].globalIndex] = 
-                        frontier + GC_ARRAY_HEADER_SIZE;
-                if (DEBUG_DETAILED)
-                        fprintf (stderr, "allocated string at 0x%x\n",
-                                        (uint)s->globals[inits[i].globalIndex]);
-                memcpy (frontier + GC_ARRAY_HEADER_SIZE, inits[i].bytes, 
-                                numBytes);
-                frontier += objectSize;
-        }
-        if (DEBUG_DETAILED)
-                fprintf (stderr, "frontier after string allocation is 0x%08x\n",
-                                (uint)frontier);
-        GC_profileAllocInc (s, frontier - s->frontier);
-        s->bytesAllocated += frontier - s->frontier;
-        assert (isAlignedFrontier (s, frontier));
-        s->frontier = frontier;
-}
-
-static void newWorld (GC_state s) {
-        int i;
-        pointer start;
-
-        for (i = 0; i < s->globalsSize; ++i)
-                s->globals[i] = (pointer)BOGUS_POINTER;
-        setInitialBytesLive (s);
-        heapCreate (s, &s->heap, heapDesiredSize (s, s->bytesLive, 0),
-                        s->bytesLive);
-        createCardMapAndCrossMap (s);
-        start = alignFrontier (s, s->heap.start);
-        s->frontier = start;
-        initIntInfs (s);
-        initStrings (s);
-        assert (s->frontier - start <= s->bytesLive);
-        s->oldGenSize = s->frontier - s->heap.start;
-        setNursery (s, 0, 0);
-        switchToThread (s, newThreadOfSize (s, initialStackSize (s)));
-}
-
-/* worldTerminator is used to separate the human readable messages at the 
- * beginning of the world file from the machine readable data.
- */
-static const char worldTerminator = '\000';
-
-static void loadWorld (GC_state s, char *fileName) {
-        FILE *file;
-        uint magic;
-        pointer oldGen;
-        int c;
-        
-        if (DEBUG_WORLD)
-                fprintf (stderr, "loadWorld (%s)\n", fileName);
-        file = sfopen (fileName, "rb");
-        until ((c = fgetc (file)) == worldTerminator or EOF == c);
-        if (EOF == c) die ("Invalid world.");
-        magic = sfreadUint (file);
-        unless (s->magic == magic)
-                die ("Invalid world: wrong magic number.");
-        oldGen = (pointer) sfreadUint (file);
-        s->oldGenSize = sfreadUint (file);
-        s->callFromCHandler = (GC_thread) sfreadUint (file);
-        s->canHandle = sfreadUint (file);
-        s->currentThread = (GC_thread) sfreadUint (file);
-        s->signalHandler = (GC_thread) sfreadUint (file);
-        heapCreate (s, &s->heap, heapDesiredSize (s, s->oldGenSize, 0),
-                        s->oldGenSize);
-        createCardMapAndCrossMap (s);
-        sfread (s->heap.start, 1, s->oldGenSize, file);
-        (*s->loadGlobals) (file);
-        unless (EOF == fgetc (file))
-                die ("Invalid world: junk at end of file.");
-        fclose (file);
-        /* translateHeap must occur after loading the heap and globals, since it
-         * changes pointers in all of them.
-         */
-        translateHeap (s, oldGen, s->heap.start, s->oldGenSize);
-        setNursery (s, 0, 0);
-        setStack (s);
-}
-
-/* ---------------------------------------------------------------- */
-/*                             GC_init                              */
-/* ---------------------------------------------------------------- */
-
-Bool MLton_Platform_CygwinUseMmap;
-
-static int processAtMLton (GC_state s, int argc, char **argv, 
-                                string *worldFile) {
-        int i;
-
-        i = 1;
-        while (s->mayProcessAtMLton 
-                and i < argc 
-                and (0 == strcmp (argv [i], "@MLton"))) {
-                bool done;
-
-                i++;
-                done = FALSE;
-                while (!done) {
-                        if (i == argc)
-                                die ("Missing -- at end of @MLton args.");
-                        else {
-                                string arg;
-
-                                arg = argv[i];
-                                if (0 == strcmp (arg, "copy-ratio")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton copy-ratio missing argument.");
-                                        s->copyRatio =
-                                                stringToFloat (argv[i++]);
-                                } else if (0 == strcmp(arg, "fixed-heap")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton fixed-heap missing argument.");
-                                        s->fixedHeap = 
-                                                align (stringToBytes (argv[i++]),
-                                                        2 * s->pageSize);
-                                } else if (0 == strcmp (arg, "gc-messages")) {
-                                        ++i;
-                                        s->messages = TRUE;
-                                } else if (0 == strcmp (arg, "gc-summary")) {
-                                        ++i;
-#if (defined (__MINGW32__))
-                                        fprintf (stderr, "Warning: MinGW doesn't yet support gc-summary\n");
-#else
-                                        s->summary = TRUE;
-#endif
-                                } else if (0 == strcmp (arg, "copy-generational-ratio")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton copy-generational-ratio missing argument.");
-                                        s->copyGenerationalRatio =
-                                                stringToFloat (argv[i++]);
-                                } else if (0 == strcmp (arg, "grow-ratio")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton grow-ratio missing argument.");
-                                        s->growRatio =
-                                                stringToFloat (argv[i++]);
-                                } else if (0 == strcmp (arg, "hash-cons")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton hash-cons missing argument.");
-                                        s->hashConsFrequency =
-                                                stringToFloat (argv[i++]);
-                                        unless (0.0 <= s->hashConsFrequency
-                                                and s->hashConsFrequency <= 1.0)
-                                                die ("@MLton hash-cons argument must be between 0.0 and 1.0");
-                                } else if (0 == strcmp (arg, "live-ratio")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton live-ratio missing argument.");
-                                        s->liveRatio =
-                                                stringToFloat (argv[i++]);
-                                } else if (0 == strcmp (arg, "load-world")) {
-                                        unless (s->mayLoadWorld)
-                                                die ("May not load world.");
-                                        ++i;
-                                        s->isOriginal = FALSE;
-                                        if (i == argc) 
-                                                die ("@MLton load-world missing argument.");
-                                        *worldFile = argv[i++];
-                                } else if (0 == strcmp (arg, "max-heap")) {
-                                        ++i;
-                                        if (i == argc) 
-                                                die ("@MLton max-heap missing argument.");
-                                        s->maxHeap = align (stringToBytes (argv[i++]),
-                                                                2 * s->pageSize);
-                                } else if (0 == strcmp (arg, "mark-compact-generational-ratio")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton mark-compact-generational-ratio missing argument.");
-                                        s->markCompactGenerationalRatio =
-                                                stringToFloat (argv[i++]);
-                                } else if (0 == strcmp (arg, "mark-compact-ratio")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton mark-compact-ratio missing argument.");
-                                        s->markCompactRatio =
-                                                stringToFloat (argv[i++]);
-                                } else if (0 == strcmp (arg, "no-load-world")) {
-                                        ++i;
-                                        s->mayLoadWorld = FALSE;
-                                } else if (0 == strcmp (arg, "nursery-ratio")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton nursery-ratio missing argument.");
-                                        s->nurseryRatio =
-                                                stringToFloat (argv[i++]);
-                                } else if (0 == strcmp (arg, "ram-slop")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton ram-slop missing argument.");
-                                        s->ramSlop =
-                                                stringToFloat (argv[i++]);
-                                } else if (0 == strcmp (arg, "show-prof")) {
-                                        showProf (s);
-                                        exit (0);
-                                } else if (0 == strcmp (arg, "stop")) {
-                                        ++i;
-                                        s->mayProcessAtMLton = FALSE;
-                                } else if (0 == strcmp (arg, "thread-shrink-ratio")) {
-                                        ++i;
-                                        if (i == argc)
-                                                die ("@MLton thread-shrink-ratio missing argument.");
-                                        s->threadShrinkRatio =
-                                                stringToFloat (argv[i++]);
-                                } else if (0 == strcmp (arg, "use-mmap")) {
-                                        ++i;
-                                        MLton_Platform_CygwinUseMmap = TRUE;
-                                } else if (0 == strcmp (arg, "--")) {
-                                        ++i;
-                                        done = TRUE;
-                                } else if (i > 1)
-                                        die ("Strange @MLton arg: %s", argv[i]);
-                                else done = TRUE;
-                        }
-                }
-        }
-        return i;
-}
-
-int GC_init (GC_state s, int argc, char **argv) {
-        char *worldFile;
-        int i;
-
-        assert (isAligned (sizeof (struct GC_stack), s->alignment));
-        assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
-                                s->alignment));
-        assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak),
-                                s->alignment));
-        MLton_Platform_CygwinUseMmap = TRUE;
-        s->amInGC = TRUE;
-        s->amInMinorGC = FALSE;
-        s->bytesAllocated = 0;
-        s->bytesCopied = 0;
-        s->bytesCopiedMinor = 0;
-        s->bytesMarkCompacted = 0;
-        s->callFromCHandler = BOGUS_THREAD;
-        s->canHandle = 0;
-        s->cardSize = 0x1 << CARD_SIZE_LOG2;
-        s->copyRatio = 4.0;
-        s->copyGenerationalRatio = 4.0;
-        s->currentThread = BOGUS_THREAD;
-        s->fixedHeap = 0.0;
-        s->gcSignalIsPending = FALSE;
-        s->growRatio = 8.0;
-        s->handleGCSignal = FALSE;
-        s->hashConsDuringGC = FALSE;
-        s->hashConsFrequency = 0.0;
-        s->inSignalHandler = FALSE;
-        s->isOriginal = TRUE;
-        s->lastMajor = GC_COPYING;
-        s->liveRatio = 8.0;
-        s->markCompactRatio = 1.04;
-        s->markCompactGenerationalRatio = 8.0;
-        s->markedCards = 0;
-        s->maxBytesLive = 0;
-        s->maxHeap = 0;
-        s->maxHeapSizeSeen = 0;
-        s->maxPause = 0;
-        s->maxStackSizeSeen = 0;
-        s->mayLoadWorld = TRUE;
-        s->mayProcessAtMLton = TRUE;
-        s->messages = FALSE;
-        s->minorBytesScanned = 0;
-        s->minorBytesSkipped = 0;
-        s->numCopyingGCs = 0;
-        s->numLCs = 0;
-        s->numHashConsGCs = 0;
-        s->numMarkCompactGCs = 0;
-        s->numMinorGCs = 0;
-        s->numMinorsSinceLastMajor = 0;
-        s->nurseryRatio = 10.0;
-        s->oldGenArraySize = 0x100000;
-        s->pageSize = getpagesize ();
-        s->ramSlop = 0.5;
-        s->rusageMeasureGC = FALSE;
-        s->savedThread = BOGUS_THREAD;
-        s->signalHandler = BOGUS_THREAD;
-        s->signalIsPending = FALSE;
-        s->startTime = currentTime ();
-        s->summary = FALSE;
-        s->threadShrinkRatio = 0.5;
-        s->weaks = NULL;
-        heapInit (&s->heap);
-        heapInit (&s->heap2);
-        sigemptyset (&s->signalsHandled);
-        initSignalStack (s);
-        sigemptyset (&s->signalsPending);
-        rusageZero (&s->ru_gc);
-        rusageZero (&s->ru_gcCopy);
-        rusageZero (&s->ru_gcMarkCompact);
-        rusageZero (&s->ru_gcMinor);
-        worldFile = NULL;
-        unless (isAligned (s->pageSize, s->cardSize))
-                die ("Page size must be a multiple of card size.");
-        processAtMLton (s, s->atMLtonsSize, s->atMLtons, &worldFile);
-        i = processAtMLton (s, argc, argv, &worldFile);
-        if (s->fixedHeap > 0 and s->maxHeap > 0)
-                die ("Cannot use both fixed-heap and max-heap.\n");
-        unless (ratiosOk (s))
-                die ("invalid ratios");
-        s->totalRam = totalRam (s);
-        /* We align s->ram by pageSize so that we can test whether or not we
-         * we are using mark-compact by comparing heap size to ram size.  If 
-         * we didn't round, the size might be slightly off.
-         */
-        s->ram = align (s->ramSlop * s->totalRam, s->pageSize);
-        if (DEBUG or DEBUG_RESIZING or s->messages)
-                fprintf (stderr, "total RAM = %s  RAM = %s\n",
-                                uintToCommaString (s->totalRam), 
-                                uintToCommaString (s->ram));
-        if (DEBUG_PROFILE) {
-                int i;
-                        for (i = 0; i < s->frameSourcesSize; ++i) {
-                        int j;
-                        uint *sourceSeq;
-                                fprintf (stderr, "%d\n", i);
-                        sourceSeq = s->sourceSeqs[s->frameSources[i]];
-                        for (j = 1; j <= sourceSeq[0]; ++j)
-                                fprintf (stderr, "\t%s\n",
-                                                s->sourceNames[s->sources[sourceSeq[j]].nameIndex]);
-                }
-        }
-        /* Initialize profiling.  This must occur after processing command-line 
-         * arguments, because those may just be doing a show prof, in which 
-         * case we don't want to initialize the atExit.
-         */
-        if (PROFILE_NONE == s->profileKind)
-                s->profilingIsOn = FALSE;
-        else {
-                s->profilingIsOn = TRUE;
-                assert (s->frameSourcesSize == s->frameLayoutsSize);
-                switch (s->profileKind) {
-                case PROFILE_ALLOC:
-                case PROFILE_COUNT:
-                        s->profile = GC_profileNew (s);
-                break;
-                case PROFILE_NONE:
-                        die ("impossible PROFILE_NONE");
-                case PROFILE_TIME:
-                        profileTimeInit (s);
-                break;
-                }
-                profileEndState = s;
-                atexit (profileEnd);
-        }
-        if (s->isOriginal) {
-                newWorld (s);
-                /* The mutator stack invariant doesn't hold,
-                 * because the mutator has yet to run.
-                 */
-                assert (mutatorInvariant (s, TRUE, FALSE));
-        } else {
-                loadWorld (s, worldFile);
-                if (s->profilingIsOn and s->profileStack)
-                        GC_foreachStackFrame (s, enterFrame);
-                assert (mutatorInvariant (s, TRUE, TRUE));
-        }
-        s->amInGC = FALSE;
-        return i;
-}
-
-extern char **environ; /* for Posix_ProcEnv_environ */
-
-void MLton_init (int argc, char **argv, GC_state s) {
-        int start;
-
-        Posix_ProcEnv_environ = (CstringArray)environ;
-        start = GC_init (s, argc, argv);
-        /* Setup argv and argc that SML sees. */
-        /* start is now the index of the first real arg. */
-        CommandLine_commandName = (uint)(argv[0]);
-        CommandLine_argc = argc - start;
-        CommandLine_argv = (uint)(argv + start);
-}
-
-static void displayCol (FILE *out, int width, string s) {
-        int extra;
-        int i;
-        int len;
-
-        len = strlen (s);
-        if (len < width) {
-                extra = width - len;
-                for (i = 0; i < extra; ++i)
-                        fprintf (out, " ");
-        }
-        fprintf (out, "%s\t", s);
-}
-
-static void displayCollectionStats (FILE *out, string name, struct rusage *ru, 
-                                        uint num, ullong bytes) {
-        uint ms;
-
-        ms = rusageTime (ru);
-        fprintf (out, "%s", name);
-        displayCol (out, 7, uintToCommaString (ms));
-        displayCol (out, 7, uintToCommaString (num));
-        displayCol (out, 15, ullongToCommaString (bytes));
-        displayCol (out, 15, 
-                        (ms > 0)
-                        ? uintToCommaString (1000.0 * (float)bytes/(float)ms)
-                        : "-");
-        fprintf (out, "\n");
-}
-
-void GC_done (GC_state s) {
-        FILE *out;
-
-        enter (s);
-        minorGC (s);
-        out = stderr;
-        if (s->summary) {
-                double time;
-                uint gcTime;
-
-                gcTime = rusageTime (&s->ru_gc);
-                fprintf (out, "GC type\t\ttime ms\t number\t\t  bytes\t      bytes/sec\n");
-                fprintf (out, "-------------\t-------\t-------\t---------------\t---------------\n");
-                displayCollectionStats
-                        (out, "copying\t\t", &s->ru_gcCopy, s->numCopyingGCs, 
-                                s->bytesCopied);
-                displayCollectionStats
-                        (out, "mark-compact\t", &s->ru_gcMarkCompact, 
-                                s->numMarkCompactGCs, s->bytesMarkCompacted);
-                displayCollectionStats
-                        (out, "minor\t\t", &s->ru_gcMinor, s->numMinorGCs, 
-                                s->bytesCopiedMinor);
-                time = (double)(currentTime () - s->startTime);
-                fprintf (out, "total GC time: %s ms (%.1f%%)\n",
-                                intToCommaString (gcTime), 
-                                (0.0 == time) 
-                                        ? 0.0 
-                                        : 100.0 * ((double) gcTime) / time);
-                fprintf (out, "max pause: %s ms\n",
-                                uintToCommaString (s->maxPause));
-                fprintf (out, "total allocated: %s bytes\n",
-                                ullongToCommaString (s->bytesAllocated));
-                fprintf (out, "max live: %s bytes\n",
-                                uintToCommaString (s->maxBytesLive));
-                fprintf (out, "max semispace: %s bytes\n", 
-                                uintToCommaString (s->maxHeapSizeSeen));
-                fprintf (out, "max stack size: %s bytes\n", 
-                                uintToCommaString (s->maxStackSizeSeen));
-                fprintf (out, "marked cards: %s\n", 
-                                ullongToCommaString (s->markedCards));
-                fprintf (out, "minor scanned: %s bytes\n",
-                                uintToCommaString (s->minorBytesScanned));
-                fprintf (out, "minor skipped: %s bytes\n", 
-                                uintToCommaString (s->minorBytesSkipped));
-        }
-        heapRelease (s, &s->heap);
-        heapRelease (s, &s->heap2);
-}
-
-void GC_finishHandler (GC_state s) {
-        if (DEBUG_SIGNALS)
-                fprintf (stderr, "GC_finishHandler ()\n");
-        assert (s->canHandle == 1);
-        s->inSignalHandler = FALSE;     
-}
-
-/* GC_handler sets s->limit = 0 so that the next limit check will fail. 
- * Signals need to be blocked during the handler (i.e. it should run atomically)
- * because sigaddset does both a read and a write of s->signalsPending.
- * The signals are blocked by Posix_Signal_handle (see Posix/Signal/Signal.c).
- */
-void GC_handler (GC_state s, int signum) {
-        if (DEBUG_SIGNALS)
-                fprintf (stderr, "GC_handler signum = %d\n", signum);
-        assert (sigismember (&s->signalsHandled, signum));
-        if (s->canHandle == 0)
-                s->limit = 0;
-        s->signalIsPending = TRUE;
-        sigaddset (&s->signalsPending, signum);
-        if (DEBUG_SIGNALS)
-                fprintf (stderr, "GC_handler done\n");
-}
-
-uint GC_size (GC_state s, pointer root) {
-        uint res;
-
-        if (DEBUG_SIZE)
-                fprintf (stderr, "GC_size marking\n");
-        res = mark (s, root, MARK_MODE, FALSE);
-        if (DEBUG_SIZE)
-                fprintf (stderr, "GC_size unmarking\n");
-        mark (s, root, UNMARK_MODE, FALSE);
-        return res;
-}
-
-void GC_saveWorld (GC_state s, int fd) {
-        char buf[80];
-
-        if (DEBUG_WORLD)
-                fprintf (stderr, "GC_saveWorld (%d).\n", fd);
-        enter (s);
-        /* Compact the heap. */
-        doGC (s, 0, 0, TRUE, TRUE);
-        sprintf (buf,
-                "Heap file created by MLton.\nheap.start = 0x%08x\nbytesLive = %u\n",
-                (uint)s->heap.start, (uint)s->bytesLive);
-        swrite (fd, buf, 1 + strlen(buf)); /* +1 to get the '\000' */
-        swriteUint (fd, s->magic);
-        swriteUint (fd, (uint)s->heap.start);
-        swriteUint (fd, (uint)s->oldGenSize);
-        swriteUint (fd, (uint)s->callFromCHandler);
-        /* canHandle must be saved in the heap, because the saveWorld may be
-         * run in the context of a critical section, which will expect to be in 
-         * the same context when it is restored.
-         */
-        swriteUint (fd, s->canHandle);
-        swriteUint (fd, (uint)s->currentThread);
-        swriteUint (fd, (uint)s->signalHandler);
-        swrite (fd, s->heap.start, s->oldGenSize);
-        (*s->saveGlobals) (fd);
-        leave (s);
-}
-
-void GC_pack (GC_state s) {
-        uint keep;
-
-        enter (s);
-        if (DEBUG or s->messages)
-                fprintf (stderr, "Packing heap of size %s.\n",
-                                uintToCommaString (s->heap.size));
-        /* Could put some code here to skip the GC if there hasn't been much
-         * allocated since the last collection.  But you would still need to 
-         * do a minor GC to make all objects contiguous.
-         */
-        doGC (s, 0, 0, TRUE, FALSE);
-        keep = s->oldGenSize * 1.1;
-        if (keep <= s->heap.size) {
-                heapShrink (s, &s->heap, keep);
-                setNursery (s, 0, 0);
-                setStack (s);
-        }
-        heapRelease (s, &s->heap2);
-        if (DEBUG or s->messages)
-                fprintf (stderr, "Packed heap to size %s.\n",
-                                uintToCommaString (s->heap.size));
-        leave (s);
-}
-
-void GC_unpack (GC_state s) {
-        enter (s);
-        if (DEBUG or s->messages)
-                fprintf (stderr, "Unpacking heap of size %s.\n",
-                                uintToCommaString (s->heap.size));
-        /* The enterGC is needed here because minorGC and resizeHeap might move
-         * the stack, and the SIGPROF catcher would then see a bogus stack.  The
-         * leaveGC has to happen after the setStack.
-         */
-        enterGC (s);
-        minorGC (s);
-        resizeHeap (s, s->oldGenSize);
-        resizeHeap2 (s);
-        setNursery (s, 0, 0);
-        setStack (s);
-        leaveGC (s);
-        if (DEBUG or s->messages)
-                fprintf (stderr, "Unpacked heap to size %s.\n",
-                                uintToCommaString (s->heap.size));
-        leave (s);
-}
-
-/* ------------------------------------------------- */
-/*                     GC_weak*                      */
-/* ------------------------------------------------- */
-
-/* A weak object is a header followed by two words.
- *
- * The object type indexed by the header determines whether the weak is valid
- * or not.  If the type has numPointers == 1, then the weak pointer is valid.  
- * Otherwise, the type has numPointers == 0 and the weak pointer is not valid.
- *
- * The first word is used to chain the live weaks together during a copying gc
- * and is otherwise unused.
- *
- * The second word is the weak pointer.
- */ 
-
-bool GC_weakCanGet (pointer p) {
-        Bool res;
-
-        res = WEAK_GONE_HEADER != GC_getHeader (p);
-        if (DEBUG_WEAK)
-                fprintf (stderr, "%s = GC_weakCanGet (0x%08x)\n",
-                                boolToString (res), (uint)p);
-        return res;
-}
-
-Pointer GC_weakGet (Pointer p) {
-        pointer res;
-
-        res = ((GC_weak)p)->object;
-        if (DEBUG_WEAK)
-                fprintf (stderr, "0x%08x = GC_weakGet (0x%08x)\n",
-                                (uint)res, (uint)p);
-        return res;
-}
-
-Pointer GC_weakNew (GC_state s, Word32 header, Pointer p) {
-        pointer res;
-
-        res = object (s, header, GC_NORMAL_HEADER_SIZE + 3 * WORD_SIZE, 
-                        FALSE, FALSE);
-        ((GC_weak)res)->object = p;
-        if (DEBUG_WEAK)
-                fprintf (stderr, "0x%08x = GC_weakNew (0x%08x, 0x%08x)\n",
-                                (uint)res, (uint)header, (uint)p);
-        return res;
-}
+#include "gc/array-allocate.c"
+#include "gc/array.c"
+#include "gc/atomic.c"
+#include "gc/call-stack.c"
+#include "gc/cheney-copy.c"
+#include "gc/controls.c"
+#include "gc/copy-thread.c"
+#include "gc/current.c"
+#include "gc/dfs-mark.c"
+#include "gc/done.c"
+#include "gc/enter_leave.c"
+#include "gc/foreach.c"
+#include "gc/forward.c"
+#include "gc/frame.c"
+#include "gc/garbage-collection.c"
+#include "gc/gc_state.c"
+#include "gc/gc_state_exports.c"
+#include "gc/generational.c"
+#include "gc/handler.c"
+#include "gc/hash-cons.c"
+#include "gc/heap.c"
+#include "gc/heap_predicates.c"
+#include "gc/init-world.c"
+#include "gc/init.c"
+#include "gc/invariant.c"
+#include "gc/mark-compact.c"
+#include "gc/model.c"
+#include "gc/new-object.c"
+#include "gc/object-size.c"
+#include "gc/object.c"
+#include "gc/pack.c"
+#include "gc/pointer.c"
+#include "gc/profiling.c"
+#include "gc/rusage.c"
+#include "gc/share.c"
+#include "gc/signals.c"
+#include "gc/size.c"
+#include "gc/sources.c"
+#include "gc/stack.c"
+#include "gc/switch-thread.c"
+#include "gc/thread.c"
+#include "gc/translate.c"
+#include "gc/weak.c"
+#include "gc/world.c"

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,712 +6,73 @@
  * See the file MLton-LICENSE for details.
  */
 
-/*
- * A two-space stop-and-copy GC.
- *
- * Has three kinds of objects: normal (fixed size), arrays, and stacks.
- */
+#ifndef _MLTON_GC_H_
+#define _MLTON_GC_H_
 
-typedef uint word;
-typedef Word64 W64;
-typedef Word32 W32;
-typedef W32 Header;
+#include "cenv.h"
+#include "util.h"
 
-/*
- * Header word bits look as follows:
- * 31           mark bit
- * 30 - 20      counter bits
- * 19 - 1       type index bits
- * 0            1
- *
- * The mark bit is used by the mark compact GC and GC_size to mark an object
- * as reachable.  The counter bits are used during the mark phase in conjunction
- * with pointer reversal to implement the mark stack.  They record the current
- * pointer
- *
- * The type index is an index into an array of struct GC_ObjectType's, where 
- * each element describes the layout of an object.  There are three kinds of
- * objects: array, normal, and stack.
- *
- * Arrays are layed out as follows
- *   counter word
- *   length word
- *   header word
- *   data words ...
- * The counter word is used during marking to help implement the mark stack.
- * The length word is the number of elements in the array.
- * The header word contains a type index that describes the layout of elements.
- * For now, arrays are either all pointers or all nonpointers.
- * 
- * Normal objects are a header word followed by the data words, which consist
- * of all nonpointer data followed by all pointer data.  
- *
- * 19 bits means that there are only 2^19 different different object layouts,
- * which appears to be plenty, since there were < 10,000 different types 
- * required for a self-compile.
- */
+struct GC_state;
+typedef struct GC_state *GC_state;
 
-/* Sizes are (almost) always measured in bytes. */
-enum {
-        BOGUS_POINTER =         0x1,
-        WORD_SIZE =             4,
-        COUNTER_MASK =          0x7FF00000,
-        COUNTER_SHIFT =         20,
-        GC_ARRAY_HEADER_SIZE =  3 * WORD_SIZE,
-        GC_NORMAL_HEADER_SIZE = WORD_SIZE,
-        TYPE_INDEX_BITS =       19,
-        TYPE_INDEX_MASK =       0x000FFFFE,
-        LIMIT_SLOP =            512,
-        MARK_MASK =             0x80000000,
-        POINTER_SIZE =          WORD_SIZE,
-        SOURCES_INDEX_UNKNOWN = 0,
-        SOURCES_INDEX_GC =      1,
-        SOURCE_SEQ_GC =         1,
-        SOURCE_SEQ_UNKNOWN =    0,
-        /* The type indices here must agree with those in
-         * backend/rep-type.fun.
-         */
-        STACK_TYPE_INDEX =      0,
-        STRING_TYPE_INDEX =     1,
-        THREAD_TYPE_INDEX =     2,
-        WEAK_GONE_TYPE_INDEX =  3,
-        WORD8_VECTOR_TYPE_INDEX = STRING_TYPE_INDEX,
-        WORD32_VECTOR_TYPE_INDEX = 4,
-        WORD16_VECTOR_TYPE_INDEX = 5,
-};
+#define GC_MODEL_NATIVE32
 
-#define BOGUS_THREAD (GC_thread)BOGUS_POINTER
+#if (defined (MLTON_GC_INTERNAL))
 
-#define TWOPOWER(n) (1 << (n))
+#include "gc/model.h"
+#include "gc/pointer.h"
+#include "gc/objptr.h"
+#include "gc/object.h"
+#include "gc/array.h"
+#include "gc/frame.h"
+#include "gc/stack.h"
+#include "gc/thread.h"
+#include "gc/weak.h"
+#include "gc/int-inf.h"
+#include "gc/string.h"
+#include "gc/object-size.h"
+#include "gc/generational.h"
+#include "gc/heap.h"
+#include "gc/current.h"
+#include "gc/foreach.h"
+#include "gc/translate.h"
+#include "gc/sysvals.h"
+#include "gc/controls.h"
+#include "gc/major.h"
+#include "gc/statistics.h"
+#include "gc/forward.h"
+#include "gc/cheney-copy.h"
+#include "gc/hash-cons.h"
+#include "gc/dfs-mark.h"
+#include "gc/mark-compact.h"
+#include "gc/invariant.h"
+#include "gc/atomic.h"
+#include "gc/enter_leave.h"
+#include "gc/signals.h"
+#include "gc/handler.h"
+#include "gc/switch-thread.h"
+#include "gc/garbage-collection.h"
+#include "gc/new-object.h"
+#include "gc/array-allocate.h"
+#include "gc/sources.h"
+#include "gc/call-stack.h"
+#include "gc/profiling.h"
+#include "gc/init-world.h"
+#include "gc/world.h"
+#include "gc/init.h"
+#include "gc/copy-thread.h"
+#include "gc/gc_state.h"
 
-typedef enum {
-        CODEGEN_BYTECODE,
-        CODEGEN_C,
-        CODEGEN_NATIVE,
-} Codegen;
+#else /* not (defined (MLTON_GC_INTERNAL)) */
 
-/* ------------------------------------------------- */
-/*                    object type                    */
-/* ------------------------------------------------- */
+struct GC_thread;
+typedef struct GC_thread *GC_thread;
+struct GC_profileData;
+typedef struct GC_profileData *GC_profileData;
 
-typedef enum { 
-        ARRAY_TAG,
-        NORMAL_TAG,
-        STACK_TAG,
-        WEAK_TAG,
-} GC_ObjectTypeTag;
+#endif /* (defined (MLTON_GC_INTERNAL)) */
 
-typedef struct {
-        /* Keep tag first, at zero offset, since it is referenced most often. */
-        GC_ObjectTypeTag tag;
-        Bool hasIdentity;
-        ushort numNonPointers;
-        ushort numPointers;
-} GC_ObjectType;
+#include "gc/gc_state_exports.h"
+#include "gc/exports.h"
 
-typedef enum {
-        GC_COPYING,
-        GC_MARK_COMPACT,
-} GC_MajorKind;
-
-/* ------------------------------------------------- */
-/*                  initialization                   */
-/* ------------------------------------------------- */
-
-/*
- * GC_init uses the array of struct intInfInits in s at program start to 
- * allocate intInfs.
- * The globalIndex'th entry of the globals array in s is set to the
- * IntInf.int whose value corresponds to the mlstr string.
- *
- * The strings pointed to by the mlstr fields consist of
- *      an optional ~
- *      either one or more of [0-9] or
- *              0x followed by one or more of [0-9a-fA-F]
- *      a trailing EOS
- */
-struct GC_intInfInit {
-        uint    globalIndex;
-        char    *mlstr;
-};
-
-/* GC_init allocates a collection of arrays/vectors in the heap. */
-struct GC_vectorInit {
-        char *bytes;
-        uint bytesPerElement;
-        uint globalIndex;
-        uint numElements;
-};
-
-/* ------------------------------------------------- */
-/*                  GC_frameLayout                   */
-/* ------------------------------------------------- */
-
-typedef ushort *GC_offsets;
-
-typedef struct GC_frameLayout {
-        /* isC is a boolean identifying whether or not the frame is for a C call.
-         */
-        char isC;
-        /* Number of bytes in frame, including space for return address. */
-        ushort numBytes;
-        /* Offsets from stackTop pointing at bottom of frame at which pointers
-         * are located. 
-         */
-        GC_offsets offsets;
-} GC_frameLayout;
-
-/* ------------------------------------------------- */
-/*                   hash consing                    */
-/* ------------------------------------------------- */
-
-typedef Word32 Hash;
-
-typedef struct GC_ObjectHashElement {
-        Hash hash;
-        Pointer object;
-} *GC_ObjectHashElement;
-
-typedef struct GC_ObjectHashTable {
-        struct GC_ObjectHashElement *elements;
-        Bool elementsIsInHeap;
-        int elementsSize;
-        int log2ElementsSize;
-        Bool mayInsert;
-        int numElements;
-} *GC_ObjectHashTable;
-
-/* ------------------------------------------------- */
-/*                     GC_stack                      */
-/* ------------------------------------------------- */
-
-typedef struct GC_stack {       
-        /* markTop and markIndex are only used during marking.  They record the
-         * current pointer in the stack that is being followed.  markTop points
-         * to the top of the stack frame containing the pointer and markI is the
-         * index in that frames frameOffsets of the pointer slot.  So, when the
-         * GC pointer reversal gets back to the stack, it can continue with the
-         * next pointer (either in the current frame or the next frame).
-         */
-        pointer markTop;
-        W32 markIndex;
-        /* reserved is the number of bytes reserved for stack, i.e. its maximum
-         * size.
-         */
-        uint reserved;
-        /* used is the number of bytes in use by the stack.  
-         * Stacks with used == reserved are continuations.
-         */
-        uint used;      
-        /* The next address is the bottom of the stack, and the following
-         * reserved bytes hold space for the stack.
-         */
-} *GC_stack;
-
-/* ------------------------------------------------- */
-/*                     GC_thread                     */
-/* ------------------------------------------------- */
-
-typedef struct GC_thread {
-        /* The order of these fields is important.  The nonpointer fields
-         * must be first, because this object must appear to be a normal heap
-         * object.
-         * Furthermore, the exnStack field must be first, because the native
-         * codegen depends on this (which is bad and should be fixed).
-         */
-        uint exnStack;          /* An offset added to stackBottom that specifies 
-                                 * where the top of the exnStack is.
-                                 */
-        uint bytesNeeded;       /* The number of bytes needed when returning
-                                 * to this thread.
-                                 */
-        GC_stack stack;         /* The stack for this thread. */
-} *GC_thread;
-
-/* ------------------------------------------------- */
-/*                      GC_weak                      */
-/* ------------------------------------------------- */
-
-typedef struct GC_weak {
-        uint unused;
-        struct GC_weak *link;
-        pointer object;
-} *GC_weak;
-
-/* ------------------------------------------------- */
-/*                     Profiling                     */
-/* ------------------------------------------------- */
-
-typedef enum {
-        PROFILE_ALLOC,
-        PROFILE_COUNT,
-        PROFILE_NONE,
-        PROFILE_TIME,
-} ProfileKind;
-
-typedef struct GC_source {
-        uint nameIndex;
-        uint successorsIndex;
-} *GC_source;
-
-typedef struct GC_sourceLabel {
-        pointer label;
-        uint sourceSeqsIndex;
-} *GC_profileLabel;
-
-/* If profileStack, then there is one struct GC_profileStackInfo for each
- * function.
- */
-typedef struct GC_profileStack {
-        /* ticks counts ticks while the function was on the stack. */
-        ullong ticks;
-        /* ticksInGC counts ticks in GC while the function was on the stack. */
-        ullong ticksInGC; 
-        /* lastTotal is the value of total when the oldest occurrence of f on the
-         * stack was pushed, i.e., the most recent time that numTimesOnStack
-         * changed from 0 to 1.  lastTotal is used to compute the amount to
-         * attribute to f when the oldest occurrence is finally popped.
-         */
-        ullong lastTotal;
-        /* lastTotalGC is like lastTotal, but for GC ticks. */
-        ullong lastTotalGC;
-        /* numOccurrences is the number of times this function is on the stack.
-         */
-        uint numOccurrences;
-} *GC_profileStack;
-
-/* GC_profile is used for both time and allocation profiling.
- * In the comments below, "ticks" mean clock ticks with time profiling and
- * bytes allocated with allocation profiling.
- *
- * All of the arrays in GC_profile are of length sourcesSize + sourceNamesSize.
- * The first soruceSizes entries are for handling the duplicate copies of 
- * functions, and the next sourceNamesSize entries are for the master versions.
- */
-typedef struct GC_profile {
-        /* countTop is an array that counts for each function the number of ticks
-         * that occurred while the function was on top of the stack.
-         */
-        ullong *countTop;
-        /* stack is an array that gives stack info for each function.  It is
-         * only used if profileStack.
-         */
-        struct GC_profileStack *stack;
-        /* The total number of mutator ticks. */
-        ullong total;
-        /* The total number of GC ticks. */
-        ullong totalGC;
-} *GC_profile;
-
-/* ------------------------------------------------- */
-/*                      GC_heap                      */
-/* ------------------------------------------------- */
-
-/* Heap layout is as follows
- *
- *  ---------------------------------------------------
- * |    old generation    |   to space   |   nursery   |
- *  ---------------------------------------------------
- *
- * If not canMinor then the to space is empty, and the nursery starts
- * immediately after the old generation.
- */
-
-typedef struct GC_heap {
-        uint size;
-        pointer start;          /* start of memory area */
-} *GC_heap;
-
-/* ------------------------------------------------- */
-/*                     GC_state                      */
-/* ------------------------------------------------- */
-
-/* General note:
- *   stackBottom, stackLimit, and stackTop are computed from 
- *   s->currentThread->stack.  It is expected that the mutator side effects these
- *   directly rather than mucking with s->currentThread->stack.  Upon entering
- *   the runtime system, the GC will update s->currentThread->stack based on
- *   these values so that everything is consistent.
- */
-
-typedef struct GC_state {
-        /* These fields are at the front because they are the most commonly
-         * referenced, and having them at smaller offsets may decrease code size.
-         */
-        pointer frontier;       /* base <= frontier < limit */
-        pointer limit;          /* end of from space */
-        pointer stackTop;
-        pointer stackLimit;     /* stackBottom + stackSize - maxFrameSize */
-        uint exnStack;
-
-        uint alignment;         /* Either WORD_SIZE or 2 * WORD_SIZE. */
-        bool amInGC;
-        bool amInMinorGC;
-        string *atMLtons;       /* Initial @MLton args, processed before command
-                                 * line.
-                                 */
-        int atMLtonsSize;
-        pointer back;           /* Points at next available word in toSpace. */
-        ullong bytesAllocated;
-        ullong bytesCopied;
-        ullong bytesCopiedMinor;
-        ullong bytesHashConsed;
-        int bytesLive; /* Number of bytes live at most recent major GC. */
-        ullong bytesMarkCompacted;
-        GC_thread callFromCHandler; /* For C calls. */
-        bool canMinor; /* TRUE iff there is space for a minor gc. */
-        pointer cardMap;
-        pointer cardMapForMutator;
-        uint cardMapSize;
-        uint cardSize;
-        uint cardSizeLog2;
-        /* Only use generational GC with copying collection if the ratio of 
-         * semispace size to live data size is below copyGenerationalRatio.
-         */
-        float copyGenerationalRatio;
-        float copyRatio;        /* Minimum live ratio to use copying GC. */
-        uchar *crossMap;
-        uint crossMapSize;
-        /* crossMapValidEnd is the size of the prefix of the old generation for
-         * which the crossMap is valid.
-         */
-        uint crossMapValidSize;
-        GC_thread currentThread; /* This points to a thread in the heap. */
-        uint fixedHeap; /* If 0, then no fixed heap. */
-        GC_frameLayout *frameLayouts;
-        uint frameLayoutsSize;
-        /* frameSources is an array of length frameLayoutsSize that for each
-         * stack frame, gives an index into sourceSeqs of the sequence of 
-         * source functions corresponding to the frame.
-         */
-        uint *frameSources;
-        uint frameSourcesSize;
-        bool gcSignalIsPending;
-        pointer *globals;
-        uint globalsSize;
-        float growRatio;
-        bool handleGCSignal;
-        Bool hashConsDuringGC;
-        float hashConsFrequency;  /* What fraction of GC's should hash cons. */
-        struct GC_heap heap;
-        struct GC_heap heap2;   /* Used for major copying collection. */
-        bool inSignalHandler;   /* TRUE iff a signal handler is running. */
-        struct GC_intInfInit *intInfInits;
-        uint intInfInitsSize;
-        /* canHandle == 0 iff GC may switch to the signal handler
-         * thread.  This is used to implement critical sections.
-         */
-        volatile int canHandle;
-        bool isOriginal;
-        GC_MajorKind lastMajor;
-        pointer limitPlusSlop; /* limit + LIMIT_SLOP */
-        float liveRatio;        /* Desired ratio of heap size to live data. */
-        /* loadGlobals loads the globals from the stream. */
-        void (*loadGlobals)(FILE *file);
-        uint magic; /* The magic number for this executable. */
-        /* Minimum live ratio to us mark-compact GC. */
-        float markCompactRatio; 
-        ullong markedCards; /* Number of marked cards seen during minor GCs. */
-        /* Only use generational GC with mark-compact collection if the ratio of 
-         * heap size to live data size is below markCompactGenerationalRatio.
-         */
-        float markCompactGenerationalRatio;
-        uint maxBytesLive;
-        uint maxFrameSize;
-        uint maxHeap; /* if zero, then unlimited, else limit total heap */
-        uint maxHeapSizeSeen;
-        uint maxPause;          /* max time spent in any gc in milliseconds. */
-        uint maxStackSizeSeen;
-        bool mayLoadWorld;
-        bool mayProcessAtMLton;
-        bool messages; /* Print out a message at the start and end of each gc. */
-        ullong minorBytesScanned;
-        ullong minorBytesSkipped;
-        bool mutatorMarksCards;
-        uint numCopyingGCs;
-        ullong numLCs;
-        uint numHashConsGCs;
-        uint numMarkCompactGCs;
-        uint numMinorGCs;
-        uint numMinorsSinceLastMajor;
-        /* As long as the ratio of bytes live to nursery size is greater than
-         * nurseryRatio, use minor GCs.
-         */
-        float nurseryRatio;
-        pointer nursery;
-        GC_ObjectHashTable objectHashTable;
-        GC_ObjectType *objectTypes; /* Array of object types. */
-        uint objectTypesSize;
-        /* Arrays larger than oldGenArraySize are allocated in the old generation
-         * instead of the nursery, if possible.
-         */
-        W32 oldGenArraySize; 
-        uint oldGenSize;
-        uint pageSize; /* bytes */
-        GC_profile profile;
-        ProfileKind profileKind;
-        bool profileStack;
-        bool profilingIsOn;
-        W32 ram;                /* ramSlop * totalRam */
-        W32 (*returnAddressToFrameIndex) (W32 w);
-        float ramSlop;
-        bool rusageMeasureGC;
-        struct rusage ru_gc; /* total resource usage spent in gc */
-        struct rusage ru_gcCopy; /* resource usage in major copying gcs. */
-        struct rusage ru_gcMarkCompact; /* resource usage in mark-compact gcs. */
-        struct rusage ru_gcMinor; /* resource usage in minor gcs. */
-        /* savedThread is only set
-         *    when executing a signal handler.  It is set to the thread that
-         *    was running when the signal arrived.
-         * GC_copyCurrentThread also uses it to store its result.
-         */
-        GC_thread savedThread;
-        /* saveGlobals writes out the values of all of the globals to fd. */
-        void (*saveGlobals)(int fd);
-        GC_thread signalHandler; /* The mutator signal handler thread. */
-        /* signalsHandled is the set of signals for which a mutator signal
-         * handler needs to run in order to handle the signal.
-         */
-        sigset_t signalsHandled;
-        /* signalIsPending is TRUE iff a signal has been received but not
-         * processed by the mutator signal handler.
-         */
-        volatile bool signalIsPending;
-        /* The signals that have been recieved but not processed by the mutator
-         * signal handler.
-         */
-        sigset_t signalsPending;
-        struct GC_sourceLabel *sourceLabels;
-        uint sourceLabelsSize;
-        /* sourcesNames is an array of strings identifying source positions. */
-        string *sourceNames;
-        uint sourceNamesSize;
-        /* Each entry in sourceSeqs is a vector, whose first element is
-         * a length, and subsequent elements index into sources.
-         */
-        uint **sourceSeqs;
-        uint sourceSeqsSize;
-        /* sources is an array of length sourcesSize.  Each entry specifies 
-         * an index into sourceNames and an index into sourceSeqs, giving the
-         * name of the function and the successors, respectively.
-         */
-        struct GC_source *sources;
-        uint sourcesSize;
-        pointer stackBottom; /* The bottom of the stack in the current thread. */
-        uint startTime; /* The time when GC_init or GC_loadWorld was called. */
-        /* If summary is TRUE, then print a summary of gc info when the program 
-         * is done .
-         */
-        bool summary; 
-        pointer textEnd;
-        /* An array of indices, one entry for each address in the text segment,
-         * giving and index into profileSourceSeqs.
-         */
-        uint *textSources;
-        pointer textStart;
-        float threadShrinkRatio;
-        pointer toSpace;        /* used during copying */
-        pointer toLimit;        /* used during copying */
-        uint totalRam;          /* bytes */
-        uint translateDiff;     /* used by translateHeap */
-        bool translateUp;       /* used by translateHeap */
-        struct GC_vectorInit *vectorInits;
-        uint vectorInitsSize;
-        GC_weak weaks;
-} *GC_state;
-
-static inline uint wordAlign(uint p) {
-        return ((p + 3) & ~ 3);
-}
-
-static inline bool isWordAligned(uint x) {
-        return 0 == (x & 0x3);
-}
-
-/* ---------------------------------------------------------------- */
-/*                           GC functions                           */
-/* ---------------------------------------------------------------- */
-
-/* GC_alignFrontier (s, p) returns the next properly aligned object start after
- * p, possibly p itself.
- */
-pointer GC_alignFrontier (GC_state s, pointer p);
-
-/* Allocate an array with the specified header and number of elements.
- * Also ensure that frontier + bytesNeeded < limit after the array is allocated.
- */
-pointer GC_arrayAllocate (GC_state s, W32 bytesNeeded, W32 numElts, W32 header);
-
-/* The array size is stored before the header */
-static inline uint* GC_arrayNumElementsp (pointer a) {
-        return ((uint*)a - 2);
-}
-
-static inline int GC_arrayNumElements (pointer a) {
-        return *(GC_arrayNumElementsp (a));
-}
-
-/* GC_copyThread (s, t) returns a copy of the thread pointed to by t.
- */
-pointer GC_copyThread (GC_state s, pointer t);
-
-/* GC_copyThread (s) stores a copy of the current thread, s->currentThread
- * in s->savedThread.  See the comment in basis-library/misc/primitive.sml for
- * why it's a bad idea to have copyCurrentThread return the copy directly.
- */
-void GC_copyCurrentThread (GC_state s);
-
-/* GC_deseralize returns the deserialization of the word8vector. */
-/* pointer GC_deserialize (GC_state s, pointer word8vector); */
-
-/* GC_display (s, str) prints out the state s to stream str. */
-void GC_display (GC_state s, FILE *stream);
-
-/* GC_done should be called after the program is done.
- * munmaps heap and stack.
- * Prints out gc statistics if s->summary is set.
- */
-void GC_done (GC_state s);
-
-/* GC_resetSignals should be called by the mutator signal handler thread when
- * it is fetching the pending signals.
- */
-void GC_resetSignals (GC_state s);
-
-/* GC_finishHandler should be called by the mutator signal handler thread when
- * it is done handling the signal.
- */
-void GC_finishHandler (GC_state s);
-
-/* GC_foreachStackFrame (s, f) applies f to the frameLayout index of each frame
- * in the stack.
- */
-void GC_foreachStackFrame (GC_state s, void (*f) (GC_state s, uint i));
-
-/* GC_gc does a gc.
- * This will also resize the stack if necessary.
- * It will also switch to the signal handler thread if there is a pending signal.
- */
-void GC_gc (GC_state s, uint bytesRequested, bool force,
-                string file, int line);
-
-/* GC_getHeaderp returns a pointer to the header for the object pointed to by 
- * p. 
- */
-static inline Header* GC_getHeaderp (pointer p) {
-        return (Header*)(p - WORD_SIZE);
-}
-
-/* GC_gerHeader returns the header for the object pointed to by p. */
-static inline Header GC_getHeader (pointer p) {
-        return *(GC_getHeaderp(p));
-}
-
-/* GC_handler is the baked-in C signal handler. 
- * It causes the next limit check to fail by setting s->limit to zero.
- * This, in turn, will cause the GC to run the SML signal handler.
- */
-void GC_handler (GC_state s, int signum);
-
-void GC_handleSigProf (pointer pc);
-
-/* GC_init must be called before doing any allocation.
- * It processes command line arguments, creates the heap, initializes the global
- * strings and intInfs.
- *
- * Before calling GC_init, you must initialize:
- *   frameLayouts
- *   globals 
- *   intInfInits
- *   loadGlobals
- *   magic
- *   maxFrameSize
- *   maxObjectTypeIndex
- *   native
- *   numFrameLayouts
- *   numGlobals
- *   objectTypes
- *   saveGlobals
- *   wordVectorInits
- *
- * GC_init returns the index of the first non-runtime command-line arg.
- */
-int GC_init (GC_state s, int argc, char **argv);
-
-/* GC_isPointer returns true if p looks like a pointer, i.e. if p = 0 mod 4. */
-static inline bool GC_isPointer (pointer p) {
-        return (0 == ((word)p & 0x3));
-}
-
-static inline bool GC_isValidFrontier (GC_state s, pointer frontier) {
-        return s->nursery <= frontier and frontier <= s->limit;
-}
-
-static inline bool GC_isValidSlot (GC_state s, pointer slot) {
-        return s->stackBottom <= slot 
-                and slot < s->stackBottom + s->currentThread->stack->reserved;
-}
-
-
-/*
- * Build the header for an object, given the index to its type info.
- */
-static inline word GC_objectHeader (W32 t) {
-        assert (t < TWOPOWER (TYPE_INDEX_BITS));
-        return 1 | (t << 1);
-}
-
-/* Pack the heap into a small amount of RAM. */
-void GC_pack (GC_state s);
-
-void GC_profileAllocInc (GC_state s, W32 amount);
-
-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, W32 amount);
-
-void GC_profileLeave (GC_state s);
-
-GC_profile GC_profileNew (GC_state s);
-
-void GC_profileWrite (GC_state s, GC_profile p, int fd);
-
-/* Write out the current world to the file descriptor. */
-void GC_saveWorld (GC_state s, int fd);
-
-/* Return a serialized version of the object rooted at root. */
-/* pointer GC_serialize(GC_state s, pointer root); */
-
-/* GC_share maximizes sharing in a single object. */
-void GC_share (GC_state s, Pointer object);
-
-/* GC_share maximizes sharing in the entire heap. */
-void GC_shareAll (GC_state s);
-
-/* Return the amount of heap space taken by the object pointed to by root. */
-uint GC_size (GC_state s, pointer root);
-
-/* Returns an array of indices corresponding to the current frames on the stack.
- * The array is terminated by 0xFFFFFFFF.
- */
-word *GC_stackFrameIndices (GC_state s);
-
-/* GC_startHandler should be called by the mutator just before switching to
- * the signal handler thread.
- */
-void GC_startHandler (GC_state s);
-
-void GC_switchToThread (GC_state s, GC_thread t, uint ensureBytesFree);
-
-void GC_unpack (GC_state s);
-
-bool GC_weakCanGet (pointer p);
-pointer GC_weakGet (pointer p);
-pointer GC_weakNew (GC_state s, W32 header, pointer p);
-
-/* initialize the machine */
-void MLton_init (int argc, char **argv, GC_state s);
+#endif /* _MLTON_GC_H_ */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.c	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -7,194 +7,3 @@
 
 #include "platform.h"
 
-void die (char *fmt, ...) {
-        va_list args;
-
-        fflush(stdout);
-        va_start(args, fmt);
-        vfprintf(stderr, fmt, args);
-        va_end(args);
-        fprintf(stderr, "\n");
-        exit(1);
-}
-
-void diee (char * fmt, ...) {
-        va_list args;
-
-        fflush(stdout);
-        va_start(args, fmt);
-        vfprintf(stderr, fmt, args);
-        va_end(args);
-        
-        fprintf(stderr, " (%s)\n", strerror(errno));
-        exit(1);
-}
-
-void asfail(char *file, int line, char *prop) {
-        fflush(stdout);
-        fprintf(stderr, "%s:%d: assert(%s) failed.\n", file, line, prop);
-        abort();
-}
-
-string boolToString (bool b) {
-        return b ? "TRUE" : "FALSE";
-}
-
-#define BUF_SIZE 81
-string intToCommaString (int n) {
-        static char buf[BUF_SIZE];
-        int i;
-        
-        i = BUF_SIZE - 1;
-        buf[i--] = '\000';
-        
-        if (0 == n)
-                buf[i--] = '0';
-        else if (INT_MIN == n) {
-                /* must treat INT_MIN specially, because I negate stuff later */
-                strcpy (buf + 1, "-2,147,483,648");
-                i = 0;
-        } else {
-                int m;
-        
-                if (n > 0) m = n; else m = -n;
-        
-                while (m > 0) {
-                        buf[i--] = m % 10 + '0';
-                        m = m / 10;
-                        if (i % 4 == 0 and m > 0) buf[i--] = ',';
-                }
-                if (n < 0) buf[i--] = '-';
-        }
-        return buf + i + 1;
-}
-
-void *scalloc (size_t nmemb, size_t size) {
-        void *res;
-
-        res = calloc (nmemb, size);
-        if (NULL == res)
-                die ("calloc (%s, %s) failed.\n", 
-                        uintToCommaString (nmemb),
-                        uintToCommaString (size));
-        return res;
-}
-
-void sclose (int fd) {
-        unless (0 == close (fd)) 
-                diee ("unable to close %d", fd);
-}
-
-void sfclose (FILE *file) {
-        unless (0 == fclose (file))
-                diee ("unable to close file");
-}
-
-FILE *sfopen (char *fileName, char *mode) {
-        FILE *file;
-        
-        if (NULL == (file = fopen ((char*)fileName, mode)))
-                diee ("sfopen unable to open file %s", fileName);
-        return file;
-}
-
-void sfread (void *ptr, size_t size, size_t nmemb, FILE *file) {
-        size_t bytes;
-
-        bytes = size * nmemb;
-        if (0 == bytes) return;
-        unless (1 == fread (ptr, bytes, 1, file))
-                diee("sfread failed");
-}
-
-uint sfreadUint (FILE *file) {
-        uint n;
-
-        sfread (&n, sizeof(uint), 1, file);
-        return n;
-}
-
-void sfwrite (void *ptr, size_t size, size_t nmemb, FILE *file) {
-        size_t bytes;
-
-        bytes = size * nmemb;
-        if (0 == bytes) return;
-        unless (1 == fwrite (ptr, size * nmemb, 1, file))
-                diee ("sfwrite failed");
-}
-
-void *smalloc (size_t length) {
-        void *res;
-
-        res = malloc (length);
-        if (NULL == res)
-                die ("Unable to malloc %s bytes.\n", uintToCommaString (length));
-        return res;
-}
-
-int smkstemp (char *template) {
-        int fd;
-
-        fd = mkstemp (template);
-        if (-1 == fd)
-                diee ("unable to make temporary file");
-        return fd;
-}
-
-void swrite (int fd, const void *buf, size_t count) {
-        if (0 == count) return;
-        unless (count == write (fd, buf, count))
-                diee ("swrite failed");
-}
-
-void swriteUint (int fd, uint n) {
-        swrite (fd, &n, sizeof(uint));
-}
-
-string uintToCommaString (uint n) {
-        static char buf1[BUF_SIZE];
-        static char buf2[BUF_SIZE];
-        static char buf3[BUF_SIZE];
-        static char buf4[BUF_SIZE];
-        static char buf5[BUF_SIZE];
-        static char *bufs[] = {buf1, buf2, buf3, buf4, buf5};
-        static int bufIndex = 0;
-        static char *buf;
-        int i;
-
-        buf = bufs[bufIndex++];
-        bufIndex %= 5;
-
-        i = BUF_SIZE - 1;
-        buf[i--] = '\000';
-        if (0 == n)
-                buf[i--] = '0';
-        else {
-                while (n > 0) {
-                        buf[i--] = n % 10 + '0';
-                        n = n / 10;
-                        if (i % 4 == 0 and n > 0) buf[i--] = ',';
-                }
-        }
-        return buf + i + 1;
-}
-
-string ullongToCommaString (ullong n) {
-        static char buf[BUF_SIZE];
-        int i;
-        
-        i = BUF_SIZE - 1;
-        buf[i--] = '\000';
-        
-        if (0 == n)
-                buf[i--] = '0';
-        else {
-                while (n > 0) {
-                        buf[i--] = n % 10 + '0';
-                        n = n / 10;
-                        if (i % 4 == 0 and n > 0) buf[i--] = ',';
-                }
-        }
-        return buf + i + 1;
-}
-

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -6,54 +6,13 @@
  * See the file MLton-LICENSE for details.
  */
 
-#ifndef _PLATFORM_H_
-#define _PLATFORM_H_
+#ifndef _MLTON_PLATFORM_H_
+#define _MLTON_PLATFORM_H_
 
-#define _ISOC99_SOURCE
-#define _BSD_SOURCE
+#include "cenv.h"
+#include "util.h"
+#include "gc.h"
 
-/* Only enable _POSIX_C_SOURCE on platforms that don't have broken system
- * headers.
- */
-#if (defined (__linux__))
-#define _POSIX_C_SOURCE 200112L
-#endif
-
-#include <sys/types.h> // lots of includes depend on this
-#include <dirent.h>
-#include <errno.h>
-#include <fcntl.h>
-#include <math.h>
-#include <signal.h>
-#include <stdarg.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <sys/stat.h>
-#include <sys/time.h>
-#include <time.h>
-#include <unistd.h>
-#include <utime.h>
-
-/* C99-specific headers */
-#include <inttypes.h>
-
-/* On FreeBSD and OpenBSD the default gmp.h is installed in /usr/include, 
- * but that is version 2.  We want gmp version 4, which is installed in 
- * /usr/local/include, and is ensured to exist because it is required by the
- * MLton package.
- * On NetBSD, we want gmp to be installed into the pkg tree (which represents
- * the FreeBSD ports tree). For now we use the same method as in the FreeBSD
- * case, but we note that this should be changed so the makefile provides the
- * correct -I flags to the compiler.
- * On MacOS X, many users will use fink to install gmp, in which case gmp.h
- * will be installed in /sw/include.
- */
-#include "gmp.h"
-
-#include "assert.h"
-
 #if (defined (__APPLE_CC__))
 #define __Darwin__
 #endif
@@ -78,50 +37,6 @@
 #error unknown platform
 #endif
 
-#ifndef bool
-#define bool    int                     /* boolean type */
-#endif
-#define uint    unsigned int            /* short names for unsigned types */
-#define ulong   unsigned long
-#define ullong  unsigned long long      /* GCC extension */
-#define llong   long long               /* GCC extension */
-#define uchar   unsigned char
-#define ushort  unsigned short int
-#define not     !                       /* logical negation operator */
-#define and     &&                      /* logical conjunction */
-#define or      ||                      /* logical disjunction */
-#ifndef TRUE
-#define TRUE    (0 == 0)
-#endif
-#ifndef FALSE
-#define FALSE   (not TRUE)
-#endif
-#define loop    while (TRUE)            /* loop until break */
-#define EOS     '\0'                    /* end-of-string char */
-#ifndef NULL
-#define NULL    0                       /* invalid pointer */
-#endif
-
-#define NEW(t, x)               x = (t)(smalloc (sizeof(*x)))
-#define ARRAY(t, a, s)  a = (t)(scalloc (s, sizeof(*a)))
-#define ARRAY_UNSAFE(t, a, s)   a = (t)(calloc (s, sizeof(*a)))
-
-#define string char*
-
-#define unless(p)       if (not (p))
-#define until(p)        while (not (p))
-#define cardof(a)       (sizeof(a) / sizeof(*(a)))
-#define endof(a)        ((a) + cardof(a))
-#define bitsof(a)       (sizeof(a) * 8)
-
-#ifndef max
-#define max(a, b) ((a)>(b)?(a):(b))
-#endif
-
-#ifndef min
-#define min(a, b) ((a)<(b)?(a):(b))
-#endif
-
 #ifndef MLton_Platform_OS_host
 #error MLton_Platform_OS_host not defined
 #endif
@@ -207,93 +122,14 @@
 #define SPAWN_MODE 0
 #endif
 
-#ifndef INT_MIN
-#define INT_MIN ((int)0x80000000)
-#endif
-#ifndef INT_MAX
-#define INT_MAX ((int)0x7FFFFFFF)
-#endif
-
 enum {
-        DEBUG_MEM = FALSE,
-        DEBUG_SIGNALS = FALSE,
+  DEBUG_MEM = FALSE,
+  DEBUG_SIGNALS = FALSE,
 };
 
 #include "types.h"
-#include "gc.h"
 
 /* ---------------------------------------------------------------- */
-/*                        Utility libraries                         */
-/* ---------------------------------------------------------------- */
-
-string boolToString (bool b);
-void decommit (void *base, size_t length);
-/* issue error message and exit */
-extern void die (char *fmt, ...)
-                        __attribute__ ((format(printf, 1, 2)))
-                        __attribute__ ((noreturn));
-/* issue error message and exit.  Also print strerror(errno). */
-extern void diee (char *fmt, ...)
-                        __attribute__ ((format(printf, 1, 2)))
-                        __attribute__ ((noreturn));
-/*
- * fixedGetrusage() works just like getrusage().  We have a wrapper because on 
- * some platforms (e.g. Linux) we need to work around kernel bugs in getrusage.
- */
-int fixedGetrusage (int who, struct rusage *rup);
-bool heapRemap (GC_state s, GC_heap h, W32 desired, W32 minSize);
-string intToCommaString (int n);
-int mkdir2 (const char *pathname, mode_t mode);
-void *mmapAnon (void *start, size_t length);
-void release (void *base, size_t length);
-void *remap (void *old,  size_t oldSize, size_t newSize);
-void *scalloc (size_t nmemb, size_t size);
-void sclose (int fd);
-void setSigProfHandler (struct sigaction *sa);
-void sfclose (FILE *file);
-FILE *sfopen (char *fileName, char *mode);
-void sfread (void *ptr, size_t size, size_t nmemb, FILE *file);
-uint sfreadUint (FILE *file);
-void sfwrite (void *ptr, size_t size, size_t nmemb, FILE *file);
-/* showMem displays the virtual memory mapping to stdout.  
- * It is used to diagnose memory problems. 
- */
-void showMem ();
-void *smalloc (size_t length);
-int smkstemp (char *template);
-void *smmap (size_t length);
-/* A super-safe mmap.
- *  Allocates a region of memory with dead zones at the high and low ends.
- *  Any attempt to touch the dead zone (read or write) will cause a
- *   segmentation fault.
- */
-void *ssmmap (size_t length, size_t dead_low, size_t dead_high);
-void swrite (int fd, const void *buf, size_t count);
-void swriteUint (int fd, uint n);
-/*
- * totalRam returns the amount of physical memory on the machine.
- */
-Word32 totalRam (GC_state s);
-string uintToCommaString (uint n);
-string ullongToCommaString (ullong n);
-
-static inline bool isBigEndian(void) {
-        union {
-                Word16 x;
-                Word8 y;
-        } z;
-        
-        /* gcc optimizes the following code to just return the result. */
-        z.x = 0xABCDU;
-        if (z.y == 0xAB) return TRUE; /* big endian */
-        if (z.y == 0xCD) return FALSE; /* little endian */
-        die ("Could not detect endian --- neither big nor little!\n");
-        return 0;
-}
-
-#define MLton_Platform_Arch_bigendian isBigEndian()
-
-/* ---------------------------------------------------------------- */
 /*                         MLton libraries                          */
 /* ---------------------------------------------------------------- */
 
@@ -354,8 +190,10 @@
 /*                        GC                         */
 /* ------------------------------------------------- */
 
-void GC_setMessages (Int b);
-void GC_setSummary (Int b);
+void MLton_GC_setHashConsDuringGC (Int b);
+void MLton_GC_setMessages (Int b);
+void MLton_GC_setSummary (Int b);
+void MLton_GC_setRusageMeasureGC (Int b);
 
 /* ------------------------------------------------- */
 /*                     IEEEReal                      */
@@ -377,24 +215,6 @@
 /*                      IntInf                       */
 /* ------------------------------------------------- */
 
-/*
- * Third header word for bignums and strings.
- */
-#define BIGMAGIC        GC_objectHeader (WORD32_VECTOR_TYPE_INDEX)
-#define STRMAGIC        GC_objectHeader (STRING_TYPE_INDEX)
-
-/*
- * Layout of bignums.  Note, the value passed around is a pointer to
- * the isneg member.
- */
-typedef struct  bignum {
-        uint    counter,        /* used by GC. */
-                card,           /* one more than the number of limbs */
-                magic,          /* BIGMAGIC */
-                isneg;          /* iff bignum is negative */
-        ulong   limbs[0];       /* big digits, least significant first */
-}       bignum;
-
 /* All of these routines modify the frontier in gcState.  They assume that 
  * there are bytes bytes free, and allocate an array to store the result
  * at the current frontier position.
@@ -450,6 +270,8 @@
 /*           MLton.Platform           */
 /* ---------------------------------- */
 
+#define MLton_Platform_Arch_bigendian isBigEndian()
+
 #if (defined (__alpha__))
 #define MLton_Platform_Arch_host "alpha"
 #elif (defined (__x86_64__))
@@ -839,7 +661,7 @@
 #define Posix_ProcEnv_VERSION _SC_VERSION
 
 enum {
-        Posix_ProcEnv_numgroups = 100,
+  Posix_ProcEnv_numgroups = 100,
 };
 
 Pid Posix_ProcEnv_getpid ();
@@ -1168,4 +990,4 @@
 
 Word Word32_arshiftAsm (Word w, Word s);
 
-#endif /* _PLATFORM_H_ */
+#endif /* _MLTON_PLATFORM_H_ */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/types.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/types.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/types.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -28,8 +28,7 @@
 typedef int16_t Int16;
 typedef int32_t Int32;
 typedef int64_t Int64;
-typedef char *Pointer;
-typedef Pointer pointer;
+typedef pointer Pointer;
 typedef float Real32;
 typedef double Real64;
 typedef uint8_t Word8;

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/Makefile (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/Makefile	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,98 @@
+## 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.
+ ##
+
+PATH = ../../bin:$(shell echo $$PATH)
+
+TARGET = self
+TARGET_ARCH = $(shell ../../bin/host-arch)
+TARGET_OS = $(shell ../../bin/host-os)
+GCC_VERSION = $(shell gcc -v 2>&1 | grep 'gcc version' | sed 's/.*gcc version \(.\).*/\1/')
+
+FLAGS = -fomit-frame-pointer
+
+ifeq ($(TARGET_ARCH), x86)
+ifneq ($(findstring $(GCC_VERSION), 3 4),)
+FLAGS += -falign-loops=2 -falign-jumps=2 -falign-functions=5
+else
+FLAGS += -malign-loops=2 -malign-jumps=2 -malign-functions=5
+endif
+DEFAULT_MODEL = A
+ALL_MODELS = A
+endif
+
+ifeq ($(TARGET_ARCH), amd64)
+FLAGS += -mtune=opteron
+DEFAULT_MODEL = BX
+ALL_MODELS = A AX B BX C CX G
+endif
+
+ifeq ($(TARGET_ARCH), sparc)
+FLAGS += -mv8 -m32
+endif
+
+ifeq ($(TARGET_OS), solaris)
+FLAGS += -Wa,-xarch=v8plusa -fcall-used-g5 -fcall-used-g7 -funroll-all-loops -mcpu=ultrasparc
+endif
+
+ifeq ($(TARGET), self)
+AR = ar rc
+RANLIB = ranlib
+else
+AR = $(TARGET)-ar rc
+RANLIB = $(TARGET)-ranlib
+FLAGS += -b $(TARGET)
+endif
+
+CC = gcc -std=gnu99
+CWFLAGS = -pedantic -Wall -Wextra -Wno-unused-parameter -Wno-unused-function \
+	-Wformat-nonliteral \
+	-Wuninitialized -Winit-self \
+	-Wstrict-aliasing=2 \
+	-Wfloat-equal \
+	-Wpointer-arith \
+	-Wbad-function-cast -Wcast-qual -Wcast-align \
+	-Waggregate-return \
+	-Wstrict-prototypes \
+	-Wmissing-noreturn -Wmissing-format-attribute \
+	-Wpacked \
+	-Wredundant-decls \
+	-Wnested-externs 
+#	-Wshadow \
+#	-Wconversion \
+#	-Wmissing-prototypes \
+#	-Wmissing-declarations \
+#	-Winline -Wdisabled-optimization
+CFLAGS = -O2 $(CWFLAGS) -I. -D_FILE_OFFSET_BITS=64 $(FLAGS)
+DEBUGFLAGS = $(CFLAGS) -Wunused -gstabs+ -g2
+
+CFILES = 							\
+	$(shell find -type f | grep '\.c$$')
+
+HFILES = 							\
+	$(shell find -type f | grep '\.h$$')
+
+all: libgc.o libgc-gdb.o
+
+libgc-gdb.o: $(CFILES) $(HFILES)
+	$(CC) $(DEBUGFLAGS) -DGC_MODEL_$(DEFAULT_MODEL) -O1 -DASSERT=1 -c -o $@ gc.c
+
+libgc.o: $(CFILES) $(HFILES)
+	$(CC) $(CFLAGS) -DGC_MODEL_$(DEFAULT_MODEL) -c -o $@ gc.c
+
+.PHONY: models
+models: $(CFILES) $(HFILES)
+	(								\
+		for m in $(ALL_MODELS); do				\
+			$(CC) $(CFLAGS) -DGC_MODEL_$$m -c -o libgc.$$m.o gc.c;	\
+			$(CC) $(DEBUGFLAGS) -O1 -DASSERT=1 -DGC_MODEL_$$m -c -o libgc-gdb.$$m.o gc.c;	\
+		done;							\
+	)
+
+.PHONY: clean
+clean:
+	../../bin/clean

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/align.h (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/align.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,45 @@
+/* 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 bool isAligned (size_t a, size_t b) {
+  return 0 == a % b;
+}
+
+static inline bool isAlignedMax (uintmax_t a, uintmax_t b) {
+  return 0 == a % b;
+}
+
+static inline size_t alignDown (size_t a, size_t b) {
+  assert (b >= 1);
+  a -= a % b;
+  assert (isAligned (a, b));
+  return a;
+}
+
+static inline uintmax_t alignMaxDown (uintmax_t a, uintmax_t b) {
+  assert (b >= 1);
+  a -= a % b;
+  assert (isAlignedMax (a, b));
+  return a;
+}
+
+static inline size_t align (size_t a, size_t b) {
+  assert (b >= 1);
+  a += b - 1;
+  a -= a % b;
+  assert (isAligned (a, b));
+  return a;       
+}
+
+static inline uintmax_t alignMax (uintmax_t a, uintmax_t b) {
+  assert (b >= 1);
+  a += b - 1;
+  a -= a % b;
+  assert (isAligned (a, b));
+  return a;       
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/assert.c (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/platform.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.c	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/assert.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,14 @@
+/* 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.
+ */
+
+#include "util.h"
+
+void asfail(char *file, int line, char *prop) {
+  fflush(stdout);
+  fprintf(stderr, "%s:%d: assert(%s) failed.\n", file, line, prop);
+  abort();
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/assert.h (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/assert.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/assert.h	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/assert.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,21 @@
+/* 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.
+ */
+
+#ifndef ASSERT
+#define ASSERT 0
+#endif
+
+/* Assertion failure routine */
+extern void asfail (char *file, int line, char *prop)
+                        __attribute__ ((noreturn));
+
+/* Assertion verifier */
+#if ASSERT
+#define assert(p) ((p) ? (void)0 : asfail(__FILE__, __LINE__, #p))
+#else
+#define assert(p) ((void)0)
+#endif

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/die.c (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/platform.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.c	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/die.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,31 @@
+/* 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.
+ */
+
+#include "util.h"
+
+void die (char *fmt, ...) {
+  va_list args;
+  
+  fflush(stdout);
+  va_start(args, fmt);
+  vfprintf(stderr, fmt, args);
+  va_end(args);
+  fprintf(stderr, "\n");
+  exit(1);
+}
+
+void diee (char * fmt, ...) {
+  va_list args;
+  
+  fflush(stdout);
+  va_start(args, fmt);
+  vfprintf(stderr, fmt, args);
+  va_end(args);
+  
+  fprintf(stderr, " (%s)\n", strerror(errno));
+  exit(1);
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/die.h (from rev 4165, mlton/branches/on-20050822-x86_64-branch/runtime/platform.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/die.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,16 @@
+/* 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.
+ */
+
+/* issue error message and exit */
+extern void die (char *fmt, ...)
+                        __attribute__ ((format(printf, 1, 2)))
+                        __attribute__ ((noreturn));
+/* issue error message and exit.  Also print strerror(errno). */
+extern void diee (char *fmt, ...)
+                        __attribute__ ((format(printf, 1, 2)))
+                        __attribute__ ((noreturn));

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/endian.h (from rev 4165, mlton/branches/on-20050822-x86_64-branch/runtime/platform.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/endian.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,25 @@
+/* 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 bool isBigEndian(void) {
+  union {
+    uint16_t x;
+    uint8_t y;
+  } z;
+  
+  /* gcc optimizes the following code to just return the result. */
+  z.x = 0xABCDU;
+  if (z.y == 0xAB) return TRUE; /* big endian */
+  if (z.y == 0xCD) return FALSE; /* little endian */
+  die ("Could not detect endian --- neither big nor little!\n");
+  return 0;
+}
+
+static inline bool isLittleEndian(void) {
+  return not (isBigEndian());
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/pointer.h (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/pointer.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,11 @@
+/* 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.
+ */
+
+typedef unsigned char* pointer;
+#define POINTER_SIZE sizeof(pointer)
+#define FMTPTR "0x%016"PRIxPTR

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/read_write.h (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/read_write.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,85 @@
+/* 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 char readChar (int fd) {
+  char res;
+  read_safe (fd, &res, sizeof(char));
+  return res;
+}
+
+static inline size_t readSize (int fd) {
+  size_t res;
+  read_safe (fd, &res, sizeof(size_t));
+  return res;
+}
+
+static inline uint32_t readUint32 (int fd) {
+  uint32_t res;
+  read_safe (fd, &res, sizeof(uint32_t));
+  return res;
+}
+
+static inline uintptr_t readUintptr (int fd) {
+  uintptr_t res;
+  read_safe (fd, &res, sizeof(uintptr_t));
+  return res;
+}
+
+static inline void writeChar (int fd, char c) {
+  write_safe (fd, &c, sizeof(char));
+}
+
+static inline void writeSize (int fd, size_t z) {
+  write_safe (fd, &z, sizeof(size_t));
+}
+
+static inline void writeUint32 (int fd, uint32_t u) {
+  write_safe (fd, &u, sizeof(uint32_t));
+}
+
+static inline void writeUintptr (int fd, uintptr_t u) {
+  write_safe (fd, &u, sizeof(uintptr_t));
+}
+
+static inline void writeString (int fd, char* s) {
+  write_safe (fd, s, strlen(s));
+}
+
+#define BUF_SIZE 81
+static inline void writeUint32U (int fd, uint32_t u) {
+  static char buf[BUF_SIZE];
+
+  sprintf (buf, "%"PRIu32, u);
+  writeString (fd, buf);
+}
+
+static inline void writeUintmaxU (int fd, uintmax_t u) {
+  static char buf[BUF_SIZE];
+
+  sprintf (buf, "%"PRIuMAX, u);
+  writeString (fd, buf);
+}
+
+static inline void writeUint32X (int fd, uint32_t u) {
+  static char buf[BUF_SIZE];
+  
+  sprintf (buf, "0x%08"PRIx32, u);
+  writeString (fd, buf);
+}
+
+static inline void writeUintmaxX (int fd, uintmax_t u) {
+  static char buf[BUF_SIZE];
+  
+  sprintf (buf, "0x%08"PRIxMAX, u);
+  writeString (fd, buf);
+}
+
+static inline void writeNewline (int fd) {
+  writeString (fd, "\n");
+}
+#undef BUF_SIZE

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/safe.h (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/safe.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,80 @@
+/* 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 *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;
+}
+
+static inline void close_safe (int fd) {
+  int res;
+
+  res = close (fd);
+  if (-1 == res)
+    diee ("close (%d) failed.\n", fd);
+  return;
+}
+
+static inline void *malloc_safe (size_t size) {
+  void *res;
+  
+  res = malloc (size);
+  if (NULL == res)
+    die ("malloc (%zu) failed.\n", size);
+  return res;
+}
+
+static inline int mkstemp_safe (char *template) {
+  int fd;
+  
+  fd = mkstemp (template);
+  if (-1 == fd)
+    diee ("mkstemp (%s) failed.\n", template);
+  return fd;
+}
+
+static inline int open_safe (const char *fileName, int flags, mode_t mode) {
+  int res;
+
+  res = open (fileName, flags, mode);
+  if (-1 == res)
+    diee ("open (%s,_,_) failed.\n", fileName);
+  return res;
+}
+
+static inline void read_safe (int fd, void *buf, size_t size) {
+  ssize_t res;
+
+  if (0 == size) return;
+  res = read (fd, buf, size);
+  if (res == -1 or (size_t)res != size)
+    diee ("read (_, _, _) failed.\n");
+}
+
+static inline void unlink_safe (const char *pathname) {
+  int res;
+
+  res = unlink (pathname);
+  if (-1 == res)
+    diee ("unlink (%s) failed.\n", pathname);
+  return;
+}
+
+static inline void write_safe (int fd, const void *buf, size_t size) {
+  ssize_t res;
+
+  if (0 == size) return;
+  res = write (fd, buf, size);
+  if (res == -1 or (size_t)res != size)
+    diee ("write (_, _, _) failed.\n");
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/to-string.c (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/to-string.c	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,128 @@
+/* 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.
+ */
+
+#include "util.h"
+
+const char* boolToString (bool b) {
+  return b ? "TRUE" : "FALSE";
+}
+
+#define BUF_SIZE 81
+char* intmaxToCommaString (intmax_t n) {
+  static char buf1[BUF_SIZE];
+  static char buf2[BUF_SIZE];
+  static char buf3[BUF_SIZE];
+  static char buf4[BUF_SIZE];
+  static char buf5[BUF_SIZE];
+  static char *bufs[] = {buf1, buf2, buf3, buf4, buf5};
+  static int bufIndex = 0;
+  static char *buf;
+  int i;
+  
+  buf = bufs[bufIndex++];
+  bufIndex %= 5;
+        
+  i = BUF_SIZE - 1;
+  buf[i--] = '\000';
+        
+  if (0 == n)
+    buf[i--] = '0';
+  else if (INTMAX_MIN == n) {
+    /* must treat INTMAX_MIN specially, because I negate stuff later */
+    switch (sizeof(intmax_t)) {
+    case 1:
+      strcpy (buf + 1, "-128");
+      break;
+    case 2:
+      strcpy (buf + 1, "-32,768");
+      break;
+    case 4:
+      strcpy (buf + 1, "-2,147,483,648");
+      break;
+    case 8:
+      strcpy (buf + 1, "-9,223,372,036,854,775,808");
+      break;
+    case 16:
+      strcpy (buf + 1, "-170,141,183,460,469,231,731,687,303,715,884,105,728");
+      break;
+    default:
+      die ("intmaxToCommaString: sizeof(intmax_t) = %zu", sizeof(intmax_t));
+      break;
+    }
+    i = 0;
+  } else {
+    intmax_t m;
+        
+    if (n > 0) 
+      m = n; 
+    else 
+      m = -n;
+        
+    while (m > 0) {
+      buf[i--] = m % 10 + '0';
+      m = m / 10;
+      if (i % 4 == 0 and m > 0) buf[i--] = ',';
+    }
+    if (n < 0) buf[i--] = '-';
+  }
+  return buf + i + 1;
+}
+
+char* uintmaxToCommaString (uintmax_t n) {
+  static char buf1[BUF_SIZE];
+  static char buf2[BUF_SIZE];
+  static char buf3[BUF_SIZE];
+  static char buf4[BUF_SIZE];
+  static char buf5[BUF_SIZE];
+  static char *bufs[] = {buf1, buf2, buf3, buf4, buf5};
+  static int bufIndex = 0;
+  static char *buf;
+  int i;
+  
+  buf = bufs[bufIndex++];
+  bufIndex %= 5;
+  
+  i = BUF_SIZE - 1;
+  buf[i--] = '\000';
+  if (0 == n)
+    buf[i--] = '0';
+  else {
+    while (n > 0) {
+      buf[i--] = n % 10 + '0';
+      n = n / 10;
+      if (i % 4 == 0 and n > 0) buf[i--] = ',';
+    }
+  }
+  return buf + i + 1;
+}
+
+char* sizeToBytesApproxString (size_t amount) {
+  static char* suffixs[] = {"", "K", "M", "G"};
+  static char buf1[BUF_SIZE];
+  static char buf2[BUF_SIZE];
+  static char buf3[BUF_SIZE];
+  static char buf4[BUF_SIZE];
+  static char buf5[BUF_SIZE];
+  static char *bufs[] = {buf1, buf2, buf3, buf4, buf5};
+  static int bufIndex = 0;
+  static char *buf;
+  size_t factor = 1;
+  int suffixIndex = 0;
+  
+  buf = bufs[bufIndex++];
+  bufIndex %= 5;
+
+  while (amount > 1024 * factor
+         and suffixIndex < 4) {
+    factor *= 1024;
+    amount /= factor;
+    suffixIndex++;
+  }
+  sprintf (buf, "%zu%s", amount, suffixs[suffixIndex]);
+  return buf;
+}
+#undef BUF_SIZE

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util/to-string.h (from rev 4164, mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c	2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/to-string.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,11 @@
+/* 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.
+ */
+
+const char* boolToString (bool b);
+char* intmaxToCommaString (intmax_t n);
+char* uintmaxToCommaString (uintmax_t n);
+char* sizeToBytesApproxString (size_t z);

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/util.h (from rev 4165, mlton/branches/on-20050822-x86_64-branch/runtime/platform.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h	2005-11-06 21:26:45 UTC (rev 4165)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util.h	2005-11-07 02:30:53 UTC (rev 4166)
@@ -0,0 +1,42 @@
+/* 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.
+ */
+
+#ifndef _MLTON_UTIL_H_
+#define _MLTON_UTIL_H_
+
+#include "cenv.h"
+#include "util/pointer.h"
+
+#ifndef TRUE
+#define TRUE    (0 == 0)
+#endif
+#ifndef FALSE
+#define FALSE   (not TRUE)
+#endif
+#define unless(p)       if (not (p))
+#define until(p)        while (not (p))
+
+#define TWOPOWER(n) (1 << (n))
+
+#ifndef max
+#define max(a, b) ((a)>(b)?(a):(b))
+#endif
+
+#ifndef min
+#define min(a, b) ((a)<(b)?(a):(b))
+#endif
+
+#include "util/assert.h"
+#include "util/die.h"
+#include "util/safe.h"
+#include "util/read_write.h"
+#include "util/to-string.h"
+#include "util/align.h"
+#include "util/endian.h"
+
+#endif /* _MLTON_UTIL_H_ */