mlton-commit Mailing List for MLton

Fixed minor Debian problem.

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

U   mlton/trunk/package/debian/mlton.doc-base

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

Modified: mlton/trunk/package/debian/mlton.doc-base
===================================================================
--- mlton/trunk/package/debian/mlton.doc-base	2005-09-17 17:38:07 UTC (rev 4096)
+++ mlton/trunk/package/debian/mlton.doc-base	2005-09-22 22:02:42 UTC (rev 4097)
@@ -6,5 +6,5 @@
 Section: Apps/Programming
 
 Format: HTML
-Index: /usr/share/doc/mlton/user-guide/Home
-Files: /usr/share/doc/mlton/user-guide/*.html
+Index: /usr/share/doc/mlton/guide/Home
+Files: /usr/share/doc/mlton/guide/*.html

Formatting
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h	2005-09-16 02:27:15 UTC (rev 4095)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h	2005-09-17 17:38:07 UTC (rev 4096)
@@ -12,6 +12,8 @@
 
 typedef uint8_t GC_cardMapElem;
 typedef uint8_t GC_crossMapElem;
+#define CARD_MAP_ELEM_SIZE sizeof(GC_cardMapElem)
+#define CROSS_MAP_ELEM_SIZE sizeof(GC_crossMapElem)
 
 struct GC_generationalMaps {
   /* cardMap is an array with cardinality equal to the size of the
@@ -37,6 +39,3 @@
    */
   size_t crossMapValidSize;
 };
-
-#define CARD_MAP_ELEM_SIZE sizeof(GC_cardMapElem)
-#define CROSS_MAP_ELEM_SIZE sizeof(GC_crossMapElem)

Display functions
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-16 02:27:15 UTC (rev 4095)
@@ -74,6 +74,7 @@
 	thread.c							\
 	generational.c							\
 	heap.c   							\
+	gc_state.c   							\
 	invariant.c   							\
 	foreach.c							\
 	cheney-copy.c							\

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c (from rev 4094, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c	2005-09-16 02:27:15 UTC (rev 4095)
@@ -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.
+ */
+
+void displayGCState (GC_state s, FILE *stream) {
+  fprintf (stream,
+           "GC state\n");
+  fprintf (stream, "\tcurrentThread"FMTOBJPTR"\n", s->currentThread);
+  displayThread (s, (GC_thread)(objptrToPointer (s->currentThread, s->heap.start)), 
+                 stream);
+  fprintf (stream, "\tgenerational\n");
+  displayGenerationalMaps (s, &s->generational, 
+                           stream);
+  fprintf (stream, "\theap\n");
+  displayHeap (s, &s->heap, 
+               stream);
+  fprintf (stream,
+           "\tlimit = "FMTPTR"\n"
+           "\tstackBottom = "FMTPTR"\n"
+           "\tstackTop = "FMTPTR"\n",
+           (uintptr_t)s->limit,
+           (uintptr_t)s->stackBottom,
+           (uintptr_t)s->stackTop);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c	2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c	2005-09-16 02:27:15 UTC (rev 4095)
@@ -235,3 +235,30 @@
     GC_munmap (oldCardMap, oldCardMapSize + oldCrossMapSize);
   }
 }
+
+void displayGenerationalMaps (GC_state s,
+                              struct GC_generationalMaps *generational,
+                              FILE *stream) {
+  fprintf(stream,
+          "\t\tcardMap ="FMTPTR"\n"
+          "\t\tcardMapAbsolute = "FMTPTR"\n"
+          "\t\tcardMapLength = %zu\n"
+          "\t\tcrossMap = "FMTPTR"\n"
+          "\t\tcrossMapLength = %zu\n"
+          "\t\tcrossMapValidSize = %zu\n",
+          (uintptr_t)generational->cardMap, 
+          (uintptr_t)generational->cardMapAbsolute,
+          generational->cardMapLength, 
+          (uintptr_t)generational->crossMap,
+          generational->crossMapLength,
+          generational->crossMapValidSize);
+  if (DEBUG_GENERATIONAL and DEBUG_DETAILED) {
+    unsigned int i;
+
+    fprintf (stderr, "crossMap trues\n");
+    for (i = 0; i < generational->crossMapLength; ++i)
+      unless (CROSS_MAP_EMPTY == generational->crossMap[i])
+        fprintf (stderr, "\t%u\n", i);
+    fprintf (stderr, "\n");
+  }               
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-09-16 02:27:15 UTC (rev 4095)
@@ -45,3 +45,17 @@
   p = objptrToPointer (op, s->heap.start);
   return pointerIsInNursery (s, p);
 }
+
+void displayHeap (GC_state s,
+                  GC_heap heap,
+                  FILE *stream) {
+  fprintf(stream,
+          "\t\tnursery ="FMTPTR"\n"
+          "\t\toldGenSize = %zu\n"
+          "\t\tstart = "FMTPTR"\n"
+          "\t\tsize = %zu\n",
+          (uintptr_t)heap->nursery,
+          heap->oldGenSize,
+          (uintptr_t)heap->start,
+          heap->size);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-09-16 02:27:15 UTC (rev 4095)
@@ -82,3 +82,13 @@
 static inline size_t stackNeedsReserved (GC_state s, GC_stack stack) {
   return stack->used + stackSlop (s) - topFrameSize(s, stack);
 }
+
+void displayStack (GC_state s,
+                   GC_stack stack, 
+                   FILE *stream) {
+  fprintf(stream,
+          "\t\treserved = %zu\n"
+          "\t\tused = %zu\n",
+          stack->reserved,
+          stack->used);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h	2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h	2005-09-16 02:27:15 UTC (rev 4095)
@@ -46,5 +46,6 @@
    * reserved bytes hold space for the stack.
    */
 } *GC_stack;
+
 #define GC_STACK_HEADER_SIZE GC_HEADER_SIZE
 #define GC_STACK_SIZE sizeof(struct GC_stack);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c	2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c	2005-09-16 02:27:15 UTC (rev 4095)
@@ -15,3 +15,17 @@
   GC_thread ct = currentThread (s);
   return ct->stack;
 }
+
+void displayThread (GC_state s,
+                    GC_thread thread, 
+                    FILE *stream) {
+  fprintf(stream,
+          "\t\texnStack = %"PRIu32"\n"
+          "\t\tbytesNeeded = %"PRIu32"\n"
+          "\t\tstack = "FMTOBJPTR"\n",
+          thread->exnStack,
+          thread->bytesNeeded,
+          thread->stack);
+  displayStack (s, (GC_stack)(objptrToPointer (thread->stack, s->heap.start)),
+                stream);
+}

Adopting the convention that the cardinality of an array is denoted by
a variable with name "zzzLength", while variables with name "zzzSize"
denote the size of the object in bytes.

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

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-14 02:50:33 UTC (rev 4094)
@@ -20,7 +20,7 @@
  */
 static inline void foreachGlobalObjptr (GC_state s, 
                                         GC_foreachObjptrFun f) {
-  for (unsigned int i = 0; i < s->globalsSize; ++i) {
+  for (unsigned int i = 0; i < s->globalsLength; ++i) {
     if (DEBUG_DETAILED)
       fprintf (stderr, "foreachGlobal %u\n", i);
     maybeCall (f, s, &s->globals [i]);
@@ -154,7 +154,7 @@
       }
       frameLayout = getFrameLayoutFromReturnAddress (s, returnAddress);
       frameOffsets = frameLayout->offsets;
-      top -= frameLayout->numBytes;
+      top -= frameLayout->size;
       for (i = 0 ; i < frameOffsets[0] ; ++i) {
         if (DEBUG)
           fprintf(stderr, "  offset %"PRIx16"  address "FMTOBJPTR"\n",

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c	2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c	2005-09-14 02:50:33 UTC (rev 4094)
@@ -24,11 +24,11 @@
   if (DEBUG_DETAILED)
     fprintf (stderr, 
              "index = %"PRIx32
-             "  frameLayoutsSize = %"PRIu16"\n",
-            index, s->frameLayoutsSize);
-  assert (index < s->frameLayoutsSize);
+             "  frameLayoutsLength = %"PRIu32"\n",
+            index, s->frameLayoutsLength);
+  assert (index < s->frameLayoutsLength);
   layout = &(s->frameLayouts[index]);
-  assert (layout->numBytes > 0);
+  assert (layout->size > 0);
   return layout;
 }
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h	2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h	2005-09-14 02:50:33 UTC (rev 4094)
@@ -19,17 +19,17 @@
  * isC field identified whether or not the frame is for a C
  * call. (Note: The ML stack is distinct from the system stack.  A C
  * call executes on the system stack.  The frame left on the ML stack
- * is just a marker.)  The numBytes field indicates the size of the
- * frame, including space for the return address.  The offsets field
- * points to an array (the zeroeth element recording the size of the
- * array) whose elements record byte offsets from the bottom of the
- * frame at which live heap pointers are located.
+ * is just a marker.)  The size field indicates the size of the frame,
+ * including space for the return address.  The offsets field points
+ * to an array (the zeroeth element recording the size of the array)
+ * whose elements record byte offsets from the bottom of the frame at
+ * which live heap pointers are located.
  */
 typedef uint16_t *GC_frameOffsets;
 
 typedef struct GC_frameLayout {
   bool isC;
-  uint16_t numBytes;
+  uint16_t size;
   GC_frameOffsets offsets;
 } GC_frameLayout;
 

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-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-09-14 02:50:33 UTC (rev 4094)
@@ -8,11 +8,11 @@
   struct GC_cumulativeStatistics cumulative;
   objptr currentThread; /* Currently executing thread (in heap). */
   GC_frameLayout *frameLayouts; /* Array of frame layouts. */
-  uint32_t frameLayoutsSize; /* Cardinality of frameLayouts array. */
+  uint32_t frameLayoutsLength; /* Cardinality of frameLayouts array. */
   pointer frontier; /* heap.start <= frontier < limit */
   struct GC_generationalMaps generational;
   objptr *globals;
-  uint32_t globalsSize;
+  uint32_t globalsLength;
   struct GC_heap heap;
   struct GC_lastMajorStatistics lastMajor;
   pointer limit; /* limit = heap.start + heap.totalBytes */
@@ -20,7 +20,7 @@
   uint32_t maxFrameSize;
   /*Bool*/bool mutatorMarksCards;
   GC_objectType *objectTypes; /* Array of object types. */
-  uint32_t objectTypesSize; /* Cardinality of objectTypes array. */
+  uint32_t objectTypesLength; /* Cardinality of objectTypes array. */
   size_t pageSize;
   uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
   objptr savedThread; /* Result of GC_copyCurrentThread.

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c	2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c	2005-09-14 02:50:33 UTC (rev 4094)
@@ -13,14 +13,14 @@
     fprintf (stderr, "invariant\n");
   // assert (ratiosOk (s));
   /* Frame layouts */
-  for (unsigned int i = 0; i < s->frameLayoutsSize; ++i) {
+  for (unsigned int i = 0; i < s->frameLayoutsLength; ++i) {
     GC_frameLayout *layout;
     
     layout = &(s->frameLayouts[i]);
-    if (layout->numBytes > 0) {
+    if (layout->size > 0) {
       GC_frameOffsets offsets;
       
-      assert (layout->numBytes <= s->maxFrameSize);
+      assert (layout->size <= 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.

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-09-14 02:50:33 UTC (rev 4094)
@@ -46,7 +46,7 @@
 
   assert (1 == (header & GC_VALID_HEADER_MASK)); 
   objectTypeIndex = (header & TYPE_INDEX_MASK) >> TYPE_INDEX_SHIFT; 
-  assert (objectTypeIndex < s->objectTypesSize); 
+  assert (objectTypeIndex < s->objectTypesLength); 
   objectType = &s->objectTypes [objectTypeIndex]; 
   tag = objectType->tag; 
   hasIdentity = objectType->hasIdentity; 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-09-14 02:50:33 UTC (rev 4094)
@@ -67,7 +67,7 @@
   
   assert (not (stackIsEmpty (stack)));
   layout = topFrameLayout (s, stack);
-  return layout->numBytes;
+  return layout->size;
 }
 
 static inline size_t stackReserved (GC_state s, size_t r) {

Changed meaning of crossMap to be a byte-offset from card start.
Record the cardinality of the maps, rather than their size.

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

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO	2005-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO	2005-09-14 02:43:18 UTC (rev 4093)
@@ -15,5 +15,3 @@
         codegen in thread.h is still true; it used to be the case when
         GC_switchToThread was implemented in codegens.  Now it should
         be implemented in Backend.
-* change the meaning of crossMap to indicate offset in bytes rather
-        than offset in 32-bit words.

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-14 02:43:18 UTC (rev 4093)
@@ -264,12 +264,11 @@
 
 /* Walk through all the cards and forward all intergenerational pointers. */
 static void forwardInterGenerationalObjptrs (GC_state s) {
-  uint8_t *cardMap;
-  uint8_t *crossMap;
-  size_t numCards;
+  GC_cardMapElem *cardMap;
+  GC_crossMapElem *crossMap;
   pointer oldGenStart, oldGenEnd;
 
-  size_t cardIndex;
+  size_t cardIndex, maxCardIndex;
   pointer cardStart, cardEnd;
   pointer objectStart;
   
@@ -279,7 +278,7 @@
   /* Constants. */
   cardMap = s->generational.cardMap;
   crossMap = s->generational.crossMap;
-  numCards = sizeToCardIndex (align (s->heap.oldGenSize, s->generational.cardSize));
+  maxCardIndex = sizeToCardIndex (align (s->heap.oldGenSize, CARD_SIZE));
   oldGenStart = s->heap.start;
   oldGenEnd = oldGenStart + s->heap.oldGenSize;
   /* Loop variables*/
@@ -287,9 +286,9 @@
   cardIndex = 0;
   cardStart = oldGenStart;
 checkAll:
-  assert (cardIndex <= numCards);
+  assert (cardIndex <= maxCardIndex);
   assert (isAlignedFrontier (s, objectStart));
-  if (cardIndex == numCards)
+  if (cardIndex == maxCardIndex)
     goto done;
 checkCard:
   if (DEBUG_GENERATIONAL)
@@ -313,7 +312,7 @@
       goto skipObjects;
     }
     s->cumulative.minorBytesSkipped += objectStart - lastObject;
-    cardEnd = cardStart + s->generational.cardSize;
+    cardEnd = cardStart + CARD_SIZE;
     if (oldGenEnd < cardEnd) 
       cardEnd = oldGenEnd;
     assert (objectStart < cardEnd);
@@ -334,16 +333,16 @@
     goto checkCard;
   } else {
     unless (CROSS_MAP_EMPTY == crossMap[cardIndex])
-      objectStart = cardStart + (crossMap[cardIndex] >> CROSS_MAP_SCALE);
+      objectStart = cardStart + (size_t)(crossMap[cardIndex]);
     if (DEBUG_GENERATIONAL)
       fprintf (stderr, 
                "card %zu is not marked"
-               "  crossMap[%zu] == %"PRIu8
+               "  crossMap[%zu] == %zu"
                "  objectStart = "FMTPTR"\n", 
                cardIndex, cardIndex, 
-               crossMap[cardIndex], (uintptr_t)objectStart);
+               (size_t)(crossMap[cardIndex]), (uintptr_t)objectStart);
     cardIndex++;
-    cardStart += s->generational.cardSize;
+    cardStart += CARD_SIZE;
     goto checkAll;
   }
   assert (FALSE);

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-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-09-14 02:43:18 UTC (rev 4093)
@@ -10,7 +10,7 @@
   GC_frameLayout *frameLayouts; /* Array of frame layouts. */
   uint32_t frameLayoutsSize; /* Cardinality of frameLayouts array. */
   pointer frontier; /* heap.start <= frontier < limit */
-  struct GC_generationalInfo generational;
+  struct GC_generationalMaps generational;
   objptr *globals;
   uint32_t globalsSize;
   struct GC_heap heap;
@@ -18,6 +18,7 @@
   pointer limit; /* limit = heap.start + heap.totalBytes */
   pointer limitPlusSlop; /* limit + LIMIT_SLOP */
   uint32_t maxFrameSize;
+  /*Bool*/bool mutatorMarksCards;
   GC_objectType *objectTypes; /* Array of object types. */
   uint32_t objectTypesSize; /* Cardinality of objectTypes array. */
   size_t pageSize;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c	2005-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c	2005-09-14 02:43:18 UTC (rev 4093)
@@ -6,11 +6,7 @@
  * See the file MLton-LICENSE for details.
  */
 
-/* must agree w/ cardSizeLog2 in ssa-to-rssa.fun */
-#define CARD_SIZE_LOG2 8
-#define CARD_SIZE TWOPOWER(CARD_SIZE_LOG2)
-#define CROSS_MAP_EMPTY 255
-#define CROSS_MAP_SCALE 2
+#define CROSS_MAP_EMPTY ((GC_crossMapElem)255)
 
 static inline uintptr_t pointerToCardIndex (pointer p) {
   return (uintptr_t)p >> CARD_SIZE_LOG2;
@@ -33,64 +29,78 @@
 }
 
 static inline bool cardIsMarked (GC_state s, pointer p) {
-  return (*pointerToCardMapAddr (s, p) != 0);
+  return (*pointerToCardMapAddr (s, p) != 0x0);
 }
 
 static inline void markCard (GC_state s, pointer p) {
   if (DEBUG_CARD_MARKING)
     fprintf (stderr, "markCard ("FMTPTR")\n", (uintptr_t)p);
-  if (s->generational.mutatorMarksCards)
+  if (s->mutatorMarksCards)
     *pointerToCardMapAddr (s, p) = 0x1;
 }
 
 static inline void clearCardMap (GC_state s) {
   if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
     fprintf (stderr, "clearCardMap ()\n");
-  memset (s->generational.cardMap, 0, s->generational.cardMapSize);
+  memset (s->generational.cardMap, 0, 
+          s->generational.cardMapLength * CARD_MAP_ELEM_SIZE);
 }
 
 static inline void clearCrossMap (GC_state s) {
   if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
     fprintf (stderr, "clearCrossMap ()\n");
   s->generational.crossMapValidSize = 0;
-  memset (s->generational.crossMap, CROSS_MAP_EMPTY, s->generational.crossMapSize);
+  memset (s->generational.crossMap, CROSS_MAP_EMPTY, 
+          s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE);
 }
 
 static inline void setCardMapAbsolute (GC_state s) {
-  unless (s->generational.mutatorMarksCards)
+  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->generational.cardMapAbsolute = 
-    s->generational.cardMap - pointerToCardIndex ( s->heap.start);
+    pointerToCardMapAddr (s, s->heap.start);
   if (DEBUG_CARD_MARKING)
     fprintf (stderr, "cardMapAbsolute = "FMTPTR"\n",
              (uintptr_t)s->generational.cardMapAbsolute);
 }
 
 static inline void createCardMapAndCrossMap (GC_state s) {
-  unless (s->generational.mutatorMarksCards) {
-    s->generational.cardMapSize = 0;
+  unless (s->mutatorMarksCards) {
+    s->generational.cardMapLength = 0;
     s->generational.cardMap = NULL;
     s->generational.cardMapAbsolute = NULL;
-    s->generational.crossMapSize = 0;
+    s->generational.crossMapLength = 0;
     s->generational.crossMap = NULL;
     return;
   }
-  assert (isAligned (s->heap.size, s->generational.cardSize));
-  s->generational.cardMapSize = 
-    align (sizeToCardIndex (s->heap.size), s->pageSize);
-  s->generational.crossMapSize = s->generational.cardMapSize;
+  assert (isAligned (s->heap.size, CARD_SIZE));
+
+  size_t cardMapLength, cardMapSize;
+  size_t crossMapLength, crossMapSize;
+  size_t totalMapSize;
+
+  cardMapLength = sizeToCardIndex (s->heap.size);
+  cardMapSize = align (cardMapLength * CARD_MAP_ELEM_SIZE, s->pageSize);
+  cardMapLength = cardMapSize / CARD_MAP_ELEM_SIZE;
+  s->generational.cardMapLength = cardMapLength;
+
+  crossMapLength = sizeToCardIndex (s->heap.size);
+  crossMapSize = align (crossMapLength * CROSS_MAP_ELEM_SIZE, s->pageSize);
+  crossMapLength = crossMapSize / CROSS_MAP_ELEM_SIZE;
+  s->generational.crossMapLength = crossMapLength;
+
+  totalMapSize = cardMapSize + crossMapSize;
   if (DEBUG_MEM)
     fprintf (stderr, "Creating card/cross map of size %zd\n",
-             /*uintToCommaString*/
-             (s->generational.cardMapSize + s->generational.crossMapSize));
+             /*uintToCommaString*/(totalMapSize));
   s->generational.cardMap = 
-    GC_mmapAnon (s->generational.cardMapSize + s->generational.crossMapSize);
+    GC_mmapAnon (totalMapSize);
   s->generational.crossMap = 
-    s->generational.cardMap + s->generational.cardMapSize;
+    (GC_crossMapElem*)((pointer)s->generational.cardMap + cardMapSize);
   if (DEBUG_CARD_MARKING)
     fprintf (stderr, "cardMap = "FMTPTR"  crossMap = "FMTPTR"\n",
              (uintptr_t)s->generational.cardMap,
@@ -108,7 +118,7 @@
    */
   return (p == s->heap.start)
     ? s->heap.start
-    : (p - 1) - ((uintptr_t)(p - 1) % s->generational.cardSize);
+    : (p - 1) - ((uintptr_t)(p - 1) % CARD_SIZE);
 }
 
 /* crossMapIsOK is a slower, but easier to understand, way of
@@ -120,7 +130,8 @@
  */
 
 static inline bool crossMapIsOK (GC_state s) {
-  static uint8_t *map;
+  static GC_crossMapElem *map;
+  size_t mapSize;
 
   pointer front, back;
   size_t cardIndex;
@@ -128,8 +139,9 @@
   
   if (DEBUG)
     fprintf (stderr, "crossMapIsOK ()\n");
-  map = GC_mmapAnon (s->generational.crossMapSize);
-  memset (map, CROSS_MAP_EMPTY, s->generational.crossMapSize);
+  mapSize = s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE;
+  map = GC_mmapAnon (mapSize);
+  memset (map, CROSS_MAP_EMPTY, mapSize);
   back = s->heap.start + s->heap.oldGenSize;
   cardIndex = 0;
   front = alignFrontier (s, s->heap.start);
@@ -137,14 +149,14 @@
   assert (front <= back);
   cardStart = crossMapCardStart (s, front);
   cardIndex = sizeToCardIndex (cardStart - s->heap.start);
-  map[cardIndex] = (front - cardStart) >> CROSS_MAP_SCALE;
+  map[cardIndex] = (front - cardStart);
   if (front < back) {
     front += objectSize (s, objectData (s, front));
     goto loopObjects;
   }
   for (size_t i = 0; i < cardIndex; ++i)
     assert (map[i] == s->generational.crossMap[i]);
-  GC_munmap (map, s->generational.crossMapSize);
+  GC_munmap (map, mapSize);
   return TRUE;
 }
 
@@ -167,7 +179,7 @@
   } else
     cardIndex = sizeToCardIndex (objectStart - 1 - s->heap.start);
   cardStart = s->heap.start + cardIndexToSize (cardIndex);
-  cardEnd = cardStart + s->generational.cardSize;
+  cardEnd = cardStart + CARD_SIZE;
 loopObjects:
   assert (objectStart < oldGenEnd);
   assert ((objectStart == s->heap.start or cardStart < objectStart)
@@ -180,21 +192,21 @@
      */
     size_t offset;
     
-    offset = (objectStart - cardStart) >> CROSS_MAP_SCALE;
+    offset = (objectStart - cardStart);
     assert (offset < CROSS_MAP_EMPTY);
     if (DEBUG_GENERATIONAL)
       fprintf (stderr, "crossMap[%zu] = %zu\n",
                cardIndex, offset);
-    s->generational.crossMap[cardIndex] = (uint8_t)offset;
+    s->generational.crossMap[cardIndex] = (GC_crossMapElem)offset;
     cardIndex = sizeToCardIndex (nextObject - 1 - s->heap.start);
     cardStart = s->heap.start + cardIndexToSize (cardIndex);
-    cardEnd = cardStart + s->generational.cardSize;
+    cardEnd = cardStart + CARD_SIZE;
   }
   objectStart = nextObject;
   if (objectStart < oldGenEnd)
     goto loopObjects;
   assert (objectStart == oldGenEnd);
-  s->generational.crossMap[cardIndex] = (oldGenEnd - cardStart) >> CROSS_MAP_SCALE;
+  s->generational.crossMap[cardIndex] = (GC_crossMapElem)(oldGenEnd - cardStart);
   s->generational.crossMapValidSize = s->heap.oldGenSize;
 done:
   assert (s->generational.crossMapValidSize == s->heap.oldGenSize);
@@ -202,21 +214,22 @@
 }
 
 static inline void resizeCardMapAndCrossMap (GC_state s) {
-  if (s->generational.mutatorMarksCards
-      and s->generational.cardMapSize 
+  if (s->mutatorMarksCards
+      and (s->generational.cardMapLength * CARD_MAP_ELEM_SIZE)
           != align (sizeToCardIndex (s->heap.size), s->pageSize)) {
-    uint8_t *oldCardMap;
+    GC_cardMapElem *oldCardMap;
     size_t oldCardMapSize;
-    uint8_t *oldCrossMap;
+    GC_crossMapElem *oldCrossMap;
     size_t oldCrossMapSize;
     
     oldCardMap = s->generational.cardMap;
-    oldCardMapSize = s->generational.cardMapSize;
+    oldCardMapSize = s->generational.cardMapLength * CARD_MAP_ELEM_SIZE;
     oldCrossMap = s->generational.crossMap;
-    oldCrossMapSize = s->generational.crossMapSize;
+    oldCrossMapSize = s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE;
     createCardMapAndCrossMap (s);
     GC_memcpy ((pointer)oldCrossMap, (pointer)s->generational.crossMap,
-               min (s->generational.crossMapSize, oldCrossMapSize));
+               min (s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE, 
+                    oldCrossMapSize));
     if (DEBUG_MEM)
       fprintf (stderr, "Releasing card/cross map.\n");
     GC_munmap (oldCardMap, oldCardMapSize + oldCrossMapSize);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h	2005-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h	2005-09-14 02:43:18 UTC (rev 4093)
@@ -6,16 +6,37 @@
  * See the file MLton-LICENSE for details.
  */
 
-struct GC_generationalInfo {
-  uint8_t *cardMap;
-  uint8_t *cardMapAbsolute;
-  size_t cardMapSize;
-  size_t cardSize;
-  uint8_t *crossMap;
-  size_t crossMapSize;
-  /* crossMapValidEnd is the size of the prefix of the old generation
+/* must agree w/ cardSizeLog2 in ssa-to-rssa.fun */
+#define CARD_SIZE_LOG2 8
+#define CARD_SIZE TWOPOWER(CARD_SIZE_LOG2)
+
+typedef uint8_t GC_cardMapElem;
+typedef uint8_t GC_crossMapElem;
+
+struct GC_generationalMaps {
+  /* cardMap is an array with cardinality equal to the size of the
+   * heap divided by card size.  Each element in the array is
+   * interpreted as a boolean; true indicates that some mutable field
+   * of some object in the corresponding card in the heap has been
+   * written since the last minor GC; hence, the corresponding card
+   * must be traced at the next minor GC.
+   */
+  GC_cardMapElem *cardMap;
+  GC_cardMapElem *cardMapAbsolute;
+  size_t cardMapLength;
+  /* crossMap is an array with cardinality equal to the size of the
+   * heap divided by card size.  Each element in the array is
+   * interpreted as a byte offset; the offset indicates the start of
+   * the last object in the corresponding card from the start of the
+   * card.
+   */
+  GC_crossMapElem *crossMap;
+  size_t crossMapLength;
+  /* crossMapValidSize the size of the prefix of the old generation
    * for which the crossMap is valid.
    */
   size_t crossMapValidSize;
-  /*Bool*/bool mutatorMarksCards;
 };
+
+#define CARD_MAP_ELEM_SIZE sizeof(GC_cardMapElem)
+#define CROSS_MAP_ELEM_SIZE sizeof(GC_crossMapElem)

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c	2005-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c	2005-09-14 02:43:18 UTC (rev 4093)
@@ -30,16 +30,17 @@
     }
   }
   /* Generational */
-  if (s->generational.mutatorMarksCards) {
+  if (s->mutatorMarksCards) {
     assert (s->generational.cardMap == 
-            &s->generational.cardMapAbsolute
-            [pointerToCardIndex(s->heap.start)]);
-    assert (&s->generational.cardMapAbsolute
-            [pointerToCardIndex(s->heap.start + s->heap.size - 1)]
-            < s->generational.cardMap + s->generational.cardMapSize);
+            &(s->generational.cardMapAbsolute
+              [pointerToCardIndex(s->heap.start)]));
+    assert (&(s->generational.cardMapAbsolute
+              [pointerToCardIndex(s->heap.start + s->heap.size - 1)])
+            < (s->generational.cardMap 
+               + (s->generational.cardMapLength * CARD_MAP_ELEM_SIZE)));
   }
   assert (isAligned (s->heap.size, s->pageSize));
-  assert (isAligned ((size_t)s->heap.start, s->generational.cardSize));
+  assert (isAligned ((size_t)s->heap.start, CARD_SIZE));
   assert (isAlignedFrontier (s, s->heap.start + s->heap.oldGenSize));
   assert (isAlignedFrontier (s, s->heap.nursery));
   assert (isAlignedFrontier (s, s->frontier));

crossMap todo item
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO	2005-09-12 02:23:11 UTC (rev 4091)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO	2005-09-12 13:50:36 UTC (rev 4092)
@@ -15,3 +15,5 @@
         codegen in thread.h is still true; it used to be the case when
         GC_switchToThread was implemented in codegens.  Now it should
         be implemented in Backend.
+* change the meaning of crossMap to indicate offset in bytes rather
+        than offset in 32-bit words.

Working on generational GC.
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-12 02:23:11 UTC (rev 4091)
@@ -51,7 +51,8 @@
 CC = gcc -std=gnu99
 CWFLAGS = -Wall -pedantic -Wextra -Wshadow -Wpointer-arith -Wcast-qual -Wcast-align -Wconversion -Wsign-compare -Wstrict-prototypes -Wredundant-decls -Winline
 CWFLAGS = -pedantic -Wall -Wextra -Wno-unused \
-	-Wshadow -Wredundant-decls \
+##	-Wshadow \
+	-Wredundant-decls \
 	-Wpointer-arith -Wcast-qual -Wcast-align \
 ##	-Wconversion \
 	-Wstrict-prototypes \
@@ -71,7 +72,9 @@
 	frame.c								\
 	stack.c								\
 	thread.c							\
+	generational.c							\
 	heap.c   							\
+	invariant.c   							\
 	foreach.c							\
 	cheney-copy.c							\
 	assumptions.c							\
@@ -81,6 +84,7 @@
 HFILES = 								\
 	gc_prefix.h							\
 	util.h								\
+	virtual-memory.h						\
 	pointer.h							\
 	model.h								\
 	object.h							\
@@ -90,6 +94,7 @@
 	thread.h							\
 	weak.h								\
 	major.h								\
+	generational.h							\
 	statistics.h							\
 	heap.h								\
 	gc_state.h							\

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -27,7 +27,7 @@
 }
 */
 
-static inline bool isAligned (uintptr_t a, size_t b) {
+static inline bool isAligned (size_t a, size_t b) {
   return 0 == a % b;
 }
 
@@ -55,16 +55,3 @@
 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;
-}
-*/

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -11,14 +11,13 @@
                                            pointer a, 
                                            uint32_t arrayIndex, 
                                            uint32_t pointerIndex) {
-  bool hasIdentity;
   GC_header header;
   uint16_t numNonObjptrs;
   uint16_t numObjptrs;
   GC_objectTypeTag tag;
   
   header = getHeader (a);
-  SPLIT_HEADER();
+  splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
   assert (tag == ARRAY_TAG);
 
   size_t nonObjptrBytesPerElement =
@@ -37,8 +36,8 @@
 /* The number of bytes in an array, not including the header. */
 static inline size_t arrayNumBytes (GC_state s,
                                     pointer p, 
-                                    uint16_t numObjptrs,
-                                    uint16_t numNonObjptrs) {
+                                    uint16_t numNonObjptrs,
+                                    uint16_t numObjptrs) {
   size_t bytesPerElement;
   GC_arrayLength numElements;
   size_t result;
@@ -53,3 +52,32 @@
     result = OBJPTR_SIZE;
   return pad (s, result, GC_ARRAY_HEADER_SIZE);
 }
+
+static inline size_t objectSize (GC_state s, pointer p) {
+  size_t headerBytes, objectBytes;
+  GC_header header;
+  GC_objectTypeTag tag;
+  uint16_t numNonObjptrs, numObjptrs;
+  
+  header = getHeader (p);
+  splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+  if (NORMAL_TAG == tag) { /* Fixed size object. */
+    headerBytes = GC_NORMAL_HEADER_SIZE;
+    objectBytes = 
+      numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+      + (numObjptrs * OBJPTR_SIZE);
+  } else if (ARRAY_TAG == tag) {
+    headerBytes = GC_ARRAY_HEADER_SIZE;
+    objectBytes = arrayNumBytes (s, p, numNonObjptrs, numObjptrs);
+  } else if (WEAK_TAG == tag) {
+    headerBytes = GC_NORMAL_HEADER_SIZE;
+    objectBytes = 
+      numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+      + (numObjptrs * OBJPTR_SIZE);
+  } else { /* Stack. */
+    assert (STACK_TAG == tag);
+    headerBytes = GC_STACK_HEADER_SIZE;
+    objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
+  }
+  return headerBytes + objectBytes;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -46,11 +46,10 @@
   return pointerIsInToSpace (p);
 }
 
-static inline void forward (GC_state s, objptr *opp) {
+static void forward (GC_state s, objptr *opp) {
   objptr op;
   pointer p;
   GC_header header;
-  GC_objectTypeTag tag;
 
   op = *opp;
   p = objptrToPointer (op, s->heap.start);
@@ -63,12 +62,14 @@
   if (DEBUG_DETAILED and header == GC_FORWARDED)
     fprintf (stderr, "  already FORWARDED\n");
   if (header != GC_FORWARDED) { /* forward the object */
-    bool hasIdentity;
     uint16_t numNonObjptrs, numObjptrs;
+    GC_objectTypeTag tag;
+
+    splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+
     size_t headerBytes, objectBytes, size, skip;
 
     /* Compute the space taken by the header and object body. */
-    SPLIT_HEADER();
     if ((NORMAL_TAG == tag) or (WEAK_TAG == tag)) { /* Fixed size object. */
       headerBytes = GC_NORMAL_HEADER_SIZE;
       objectBytes = 
@@ -77,7 +78,7 @@
       skip = 0;
     } else if (ARRAY_TAG == tag) {
       headerBytes = GC_ARRAY_HEADER_SIZE;
-      objectBytes = arrayNumBytes (s, p, numObjptrs, numNonObjptrs);
+      objectBytes = arrayNumBytes (s, p, numNonObjptrs, numObjptrs);
       skip = 0;
     } else { /* Stack. */
       GC_stack stack;
@@ -122,7 +123,7 @@
     size = headerBytes + objectBytes;
     assert (forwardState.back + size + skip <= forwardState.toLimit);
     /* Copy the object. */
-    copy (p - headerBytes, forwardState.back, size);
+    GC_memcpy (p - headerBytes, forwardState.back, size);
     /* If the object has a valid weak pointer, link it into the weaks
      * for update after the copying GC is done.
      */
@@ -189,7 +190,7 @@
   tempHeap = s->secondaryHeap;
   s->secondaryHeap = s->heap;
   s->heap = tempHeap;
-  // setCardMapForMutator (s);
+  setCardMapAbsolute (s);
 }
 
 /* static inline bool detailedGCTime (GC_state s) { */
@@ -200,43 +201,204 @@
   // struct rusage ru_start;
   pointer toStart;
 
-  assert (s->secondaryHeap.totalBytes >= s->heap.oldGenBytes);
+  assert (s->secondaryHeap.size >= s->heap.oldGenSize);
 /*   if (detailedGCTime (s)) */
 /*     startTiming (&ru_start); */
   s->cumulative.numCopyingGCs++;
   forwardState.toStart = s->secondaryHeap.start;
-  forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.totalBytes;
+  forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.size;
   if (DEBUG or s->messages) {
     fprintf (stderr, "Major copying GC.\n");
     fprintf (stderr, "fromSpace = "FMTPTR" of size %zd\n",
              (uintptr_t) s->heap.start, 
-             /*uintToCommaString*/(s->heap.totalBytes));
+             /*uintToCommaString*/(s->heap.size));
     fprintf (stderr, "toSpace = "FMTPTR" of size %zd\n",
              (uintptr_t) s->secondaryHeap.start, 
-             /*uintToCommaString*/(s->secondaryHeap.totalBytes));
+             /*uintToCommaString*/(s->secondaryHeap.size));
   }
   assert (s->secondaryHeap.start != (pointer)NULL);
   /* The next assert ensures there is enough space for the copy to
    * succeed.  It does not assert 
-   *   (s->secondaryHeap.totalBytes >= s->heap.totalByes) 
+   *   (s->secondaryHeap.size >= s->heap.size) 
    * because that is too strong.
    */
-  assert (s->secondaryHeap.totalBytes >= s->heap.oldGenBytes);
+  assert (s->secondaryHeap.size >= s->heap.oldGenSize);
   toStart = alignFrontier (s, s->secondaryHeap.start);
   forwardState.back = toStart;
   foreachGlobalObjptr (s, forward);
   foreachObjptrInRange (s, toStart, &forwardState.back, TRUE, forward);
   updateWeaks (s);
-  s->secondaryHeap.oldGenBytes = forwardState.back - s->secondaryHeap.start;
-  s->cumulative.bytesCopied += s->secondaryHeap.oldGenBytes;
+  s->secondaryHeap.oldGenSize = forwardState.back - s->secondaryHeap.start;
+  s->cumulative.bytesCopied += s->secondaryHeap.oldGenSize;
   if (DEBUG)
     fprintf (stderr, "%zd bytes live.\n",
-             /*uintToCommaString*/(s->secondaryHeap.oldGenBytes));
+             /*uintToCommaString*/(s->secondaryHeap.oldGenSize));
   swapHeaps (s);
-  // clearCrossMap (s);
+  clearCrossMap (s);
   s->lastMajor.kind = GC_COPYING;
 /*   if (detailedGCTime (s)) */
 /*     stopTiming (&ru_start, &s->ru_gcCopy); */
   if (DEBUG or s->messages)
     fprintf (stderr, "Major copying GC done.\n");
 }
+
+/* ---------------------------------------------------------------- */
+/*                 Minor Cheney Copying Collection                  */
+/* ---------------------------------------------------------------- */
+
+static inline void forwardIfInNursery (GC_state s, objptr *opp) {
+  objptr op;
+  pointer p;
+
+  op = *opp;
+  p = objptrToPointer (op, s->heap.start);
+  if (p < s->heap.nursery)
+    return;
+  if (DEBUG_GENERATIONAL)
+    fprintf (stderr,
+             "forwardIfInNursery  opp = "FMTPTR"  op = "FMTOBJPTR"  p = "FMTPTR"\n",
+             (uintptr_t)opp, op, (uintptr_t)p);
+  assert (s->heap.nursery <= p and p < s->limitPlusSlop);
+  forward (s, opp);
+}
+
+/* Walk through all the cards and forward all intergenerational pointers. */
+static void forwardInterGenerationalObjptrs (GC_state s) {
+  uint8_t *cardMap;
+  uint8_t *crossMap;
+  size_t numCards;
+  pointer oldGenStart, oldGenEnd;
+
+  size_t cardIndex;
+  pointer cardStart, cardEnd;
+  pointer objectStart;
+  
+  if (DEBUG_GENERATIONAL)
+    fprintf (stderr, "Forwarding inter-generational pointers.\n");
+  updateCrossMap (s);
+  /* Constants. */
+  cardMap = s->generational.cardMap;
+  crossMap = s->generational.crossMap;
+  numCards = sizeToCardIndex (align (s->heap.oldGenSize, s->generational.cardSize));
+  oldGenStart = s->heap.start;
+  oldGenEnd = oldGenStart + s->heap.oldGenSize;
+  /* Loop variables*/
+  objectStart = alignFrontier (s, s->heap.start);
+  cardIndex = 0;
+  cardStart = oldGenStart;
+checkAll:
+  assert (cardIndex <= numCards);
+  assert (isAlignedFrontier (s, objectStart));
+  if (cardIndex == numCards)
+    goto done;
+checkCard:
+  if (DEBUG_GENERATIONAL)
+    fprintf (stderr, "checking card %zu  objectStart = "FMTPTR"\n",
+             cardIndex, (uintptr_t)objectStart);
+  assert (objectStart < oldGenStart + cardIndexToSize (cardIndex + 1));
+  if (cardMap[cardIndex]) {
+    pointer lastObject;
+    size_t size;
+    
+    s->cumulative.markedCards++;
+    if (DEBUG_GENERATIONAL)
+      fprintf (stderr, "card %zu is marked  objectStart = "FMTPTR"\n", 
+               cardIndex, (uintptr_t)objectStart);
+    lastObject = objectStart;
+skipObjects:
+    assert (isAlignedFrontier (s, objectStart));
+    size = objectSize (s, objectData (s, objectStart));
+    if (objectStart + size < cardStart) {
+      objectStart += size;
+      goto skipObjects;
+    }
+    s->cumulative.minorBytesSkipped += objectStart - lastObject;
+    cardEnd = cardStart + s->generational.cardSize;
+    if (oldGenEnd < cardEnd) 
+      cardEnd = oldGenEnd;
+    assert (objectStart < cardEnd);
+    lastObject = 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 foreachObjptrInRange will do the right thing on
+     * weaks, since the weak pointer will never be into the nursery.
+     */
+    objectStart = foreachObjptrInRange (s, objectStart, &cardEnd, 
+                                        FALSE, forwardIfInNursery);
+    s->cumulative.minorBytesScanned += objectStart - lastObject;
+    if (objectStart == oldGenEnd)
+      goto done;
+    cardIndex = sizeToCardIndex (objectStart - oldGenStart);
+    cardStart = oldGenStart + cardIndexToSize (cardIndex);
+    goto checkCard;
+  } else {
+    unless (CROSS_MAP_EMPTY == crossMap[cardIndex])
+      objectStart = cardStart + (crossMap[cardIndex] >> CROSS_MAP_SCALE);
+    if (DEBUG_GENERATIONAL)
+      fprintf (stderr, 
+               "card %zu is not marked"
+               "  crossMap[%zu] == %"PRIu8
+               "  objectStart = "FMTPTR"\n", 
+               cardIndex, cardIndex, 
+               crossMap[cardIndex], (uintptr_t)objectStart);
+    cardIndex++;
+    cardStart += s->generational.cardSize;
+    goto checkAll;
+  }
+  assert (FALSE);
+done:
+  if (DEBUG_GENERATIONAL)
+    fprintf (stderr, "Forwarding inter-generational pointers done.\n");
+}
+
+static void minorGC (GC_state s) {
+  size_t bytesAllocated;
+  size_t bytesCopied;
+  // struct rusage ru_start;
+
+  if (DEBUG_GENERATIONAL)
+    fprintf (stderr, "minorGC  nursery = "FMTPTR"  frontier = "FMTPTR"\n",
+             (uintptr_t)s->heap.nursery, (uintptr_t)s->frontier);
+  assert (invariant (s));
+  bytesAllocated = s->frontier - s->heap.nursery;
+  if (bytesAllocated == 0)
+    return;
+  s->cumulative.bytesAllocated += bytesAllocated;
+  if (not s->canMinor) {
+    s->heap.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;
+    forwardState.toStart = s->heap.start + s->heap.oldGenSize;
+    if (DEBUG_GENERATIONAL)
+      fprintf (stderr, "toStart = "FMTPTR"\n", (uintptr_t)forwardState.toStart);
+    assert (isAlignedFrontier (s, forwardState.toStart));
+    forwardState.toLimit = forwardState.toStart + bytesAllocated;
+    assert (invariant (s));
+    s->cumulative.numMinorGCs++;
+    s->lastMajor.numMinorsGCs++;
+    forwardState.back = forwardState.toStart;
+    /* Forward all globals.  Would like to avoid doing this once all
+     * the globals have been assigned.
+     */
+    foreachGlobalObjptr (s, forwardIfInNursery);
+    forwardInterGenerationalObjptrs (s);
+    foreachObjptrInRange (s, forwardState.toStart, &forwardState.back, 
+                          TRUE, forwardIfInNursery);
+    updateWeaks (s);
+    bytesCopied = forwardState.back - forwardState.toStart;
+    s->cumulative.bytesCopiedMinor += bytesCopied;
+    s->heap.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.  %zd bytes copied.\n",
+               /*uintToCommaString*/(bytesCopied));
+  }
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -18,6 +18,7 @@
         DEBUG_ENTER_LEAVE = FALSE,
         DEBUG_GENERATIONAL = FALSE,
         DEBUG_MARK_COMPACT = FALSE,
+        DEBUG_MEM = FALSE,
         DEBUG_PROFILE = FALSE,
         DEBUG_RESIZING = FALSE,
         DEBUG_SHARE = FALSE,

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -45,14 +45,13 @@
                                              pointer p,
                                              bool skipWeaks,
                                              GC_foreachObjptrFun f) {
-  bool hasIdentity;
   GC_header header;
   uint16_t numNonObjptrs;
   uint16_t numObjptrs;
   GC_objectTypeTag tag;
 
   header = getHeader (p);
-  SPLIT_HEADER();
+  splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
   if (DEBUG_DETAILED)
     fprintf (stderr, 
              "foreachObjptrInObject ("FMTPTR")"
@@ -202,7 +201,7 @@
         fprintf (stderr, 
                  "  front = "FMTPTR"  *back = "FMTPTR"\n",
                  (uintptr_t)front, (uintptr_t)(*back));
-      front = foreachObjptrInObject (s, toData (s, front), skipWeaks, f);
+      front = foreachObjptrInObject (s, objectData (s, front), skipWeaks, f);
     }
     b = *back;
   }

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-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-09-12 02:23:11 UTC (rev 4091)
@@ -4,19 +4,23 @@
   bool amInGC;
   bool amInMinorGC;
   objptr callFromCHandler; /* Handler for exported C calls (in heap). */
+  bool canMinor; /* TRUE iff there is space for a minor gc. */
   struct GC_cumulativeStatistics cumulative;
   objptr currentThread; /* Currently executing thread (in heap). */
   GC_frameLayout *frameLayouts; /* Array of frame layouts. */
   uint32_t frameLayoutsSize; /* Cardinality of frameLayouts array. */
   pointer frontier; /* heap.start <= frontier < limit */
+  struct GC_generationalInfo generational;
   objptr *globals;
   uint32_t globalsSize;
   struct GC_heap heap;
   struct GC_lastMajorStatistics lastMajor;
   pointer limit; /* limit = heap.start + heap.totalBytes */
+  pointer limitPlusSlop; /* limit + LIMIT_SLOP */
   uint32_t maxFrameSize;
   GC_objectType *objectTypes; /* Array of object types. */
   uint32_t objectTypesSize; /* Cardinality of objectTypes array. */
+  size_t pageSize;
   uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
   objptr savedThread; /* Result of GC_copyCurrentThread.
                        * Thread interrupted by arrival of signal.

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c (from rev 4078, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -0,0 +1,224 @@
+/* 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.
+ */
+
+/* must agree w/ cardSizeLog2 in ssa-to-rssa.fun */
+#define CARD_SIZE_LOG2 8
+#define CARD_SIZE TWOPOWER(CARD_SIZE_LOG2)
+#define CROSS_MAP_EMPTY 255
+#define CROSS_MAP_SCALE 2
+
+static inline uintptr_t pointerToCardIndex (pointer p) {
+  return (uintptr_t)p >> CARD_SIZE_LOG2;
+}
+static inline size_t sizeToCardIndex (size_t n) {
+  return n >> CARD_SIZE_LOG2;
+}
+static inline size_t cardIndexToSize (size_t n) {
+  return n << CARD_SIZE_LOG2;
+}
+
+static inline pointer pointerToCardMapAddr (GC_state s, pointer p) {
+  pointer res;
+  
+  res = &s->generational.cardMapAbsolute [pointerToCardIndex (p)];
+  if (DEBUG_CARD_MARKING)
+    fprintf (stderr, "pointerToCardMapAddr ("FMTPTR") = "FMTPTR"\n",
+             (uintptr_t)p, (uintptr_t)res);
+  return res;
+}
+
+static inline bool cardIsMarked (GC_state s, pointer p) {
+  return (*pointerToCardMapAddr (s, p) != 0);
+}
+
+static inline void markCard (GC_state s, pointer p) {
+  if (DEBUG_CARD_MARKING)
+    fprintf (stderr, "markCard ("FMTPTR")\n", (uintptr_t)p);
+  if (s->generational.mutatorMarksCards)
+    *pointerToCardMapAddr (s, p) = 0x1;
+}
+
+static inline void clearCardMap (GC_state s) {
+  if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
+    fprintf (stderr, "clearCardMap ()\n");
+  memset (s->generational.cardMap, 0, s->generational.cardMapSize);
+}
+
+static inline void clearCrossMap (GC_state s) {
+  if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
+    fprintf (stderr, "clearCrossMap ()\n");
+  s->generational.crossMapValidSize = 0;
+  memset (s->generational.crossMap, CROSS_MAP_EMPTY, s->generational.crossMapSize);
+}
+
+static inline void setCardMapAbsolute (GC_state s) {
+  unless (s->generational.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->generational.cardMapAbsolute = 
+    s->generational.cardMap - pointerToCardIndex ( s->heap.start);
+  if (DEBUG_CARD_MARKING)
+    fprintf (stderr, "cardMapAbsolute = "FMTPTR"\n",
+             (uintptr_t)s->generational.cardMapAbsolute);
+}
+
+static inline void createCardMapAndCrossMap (GC_state s) {
+  unless (s->generational.mutatorMarksCards) {
+    s->generational.cardMapSize = 0;
+    s->generational.cardMap = NULL;
+    s->generational.cardMapAbsolute = NULL;
+    s->generational.crossMapSize = 0;
+    s->generational.crossMap = NULL;
+    return;
+  }
+  assert (isAligned (s->heap.size, s->generational.cardSize));
+  s->generational.cardMapSize = 
+    align (sizeToCardIndex (s->heap.size), s->pageSize);
+  s->generational.crossMapSize = s->generational.cardMapSize;
+  if (DEBUG_MEM)
+    fprintf (stderr, "Creating card/cross map of size %zd\n",
+             /*uintToCommaString*/
+             (s->generational.cardMapSize + s->generational.crossMapSize));
+  s->generational.cardMap = 
+    GC_mmapAnon (s->generational.cardMapSize + s->generational.crossMapSize);
+  s->generational.crossMap = 
+    s->generational.cardMap + s->generational.cardMapSize;
+  if (DEBUG_CARD_MARKING)
+    fprintf (stderr, "cardMap = "FMTPTR"  crossMap = "FMTPTR"\n",
+             (uintptr_t)s->generational.cardMap,
+             (uintptr_t)s->generational.crossMap);
+  setCardMapAbsolute (s);
+  clearCardMap (s);
+  clearCrossMap (s);
+}
+
+#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) - ((uintptr_t)(p - 1) % s->generational.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 inline bool crossMapIsOK (GC_state s) {
+  static uint8_t *map;
+
+  pointer front, back;
+  size_t cardIndex;
+  pointer cardStart;
+  
+  if (DEBUG)
+    fprintf (stderr, "crossMapIsOK ()\n");
+  map = GC_mmapAnon (s->generational.crossMapSize);
+  memset (map, CROSS_MAP_EMPTY, s->generational.crossMapSize);
+  back = s->heap.start + s->heap.oldGenSize;
+  cardIndex = 0;
+  front = alignFrontier (s, s->heap.start);
+loopObjects:
+  assert (front <= back);
+  cardStart = crossMapCardStart (s, front);
+  cardIndex = sizeToCardIndex (cardStart - s->heap.start);
+  map[cardIndex] = (front - cardStart) >> CROSS_MAP_SCALE;
+  if (front < back) {
+    front += objectSize (s, objectData (s, front));
+    goto loopObjects;
+  }
+  for (size_t i = 0; i < cardIndex; ++i)
+    assert (map[i] == s->generational.crossMap[i]);
+  GC_munmap (map, s->generational.crossMapSize);
+  return TRUE;
+}
+
+#endif /* ASSERT */
+
+static inline void updateCrossMap (GC_state s) {
+  size_t cardIndex;
+  pointer cardStart, cardEnd;
+
+  pointer nextObject, objectStart;
+  pointer oldGenEnd;
+  
+  if (s->generational.crossMapValidSize == s->heap.oldGenSize)
+    goto done;
+  oldGenEnd = s->heap.start + s->heap.oldGenSize;
+  objectStart = s->heap.start + s->generational.crossMapValidSize;
+  if (objectStart == s->heap.start) {
+    cardIndex = 0;
+    objectStart = alignFrontier (s, objectStart);
+  } else
+    cardIndex = sizeToCardIndex (objectStart - 1 - s->heap.start);
+  cardStart = s->heap.start + cardIndexToSize (cardIndex);
+  cardEnd = cardStart + s->generational.cardSize;
+loopObjects:
+  assert (objectStart < oldGenEnd);
+  assert ((objectStart == s->heap.start or cardStart < objectStart)
+          and objectStart <= cardEnd);
+  nextObject = objectStart + objectSize (s, objectData (s, objectStart));
+  if (nextObject > 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.
+     */
+    size_t offset;
+    
+    offset = (objectStart - cardStart) >> CROSS_MAP_SCALE;
+    assert (offset < CROSS_MAP_EMPTY);
+    if (DEBUG_GENERATIONAL)
+      fprintf (stderr, "crossMap[%zu] = %zu\n",
+               cardIndex, offset);
+    s->generational.crossMap[cardIndex] = (uint8_t)offset;
+    cardIndex = sizeToCardIndex (nextObject - 1 - s->heap.start);
+    cardStart = s->heap.start + cardIndexToSize (cardIndex);
+    cardEnd = cardStart + s->generational.cardSize;
+  }
+  objectStart = nextObject;
+  if (objectStart < oldGenEnd)
+    goto loopObjects;
+  assert (objectStart == oldGenEnd);
+  s->generational.crossMap[cardIndex] = (oldGenEnd - cardStart) >> CROSS_MAP_SCALE;
+  s->generational.crossMapValidSize = s->heap.oldGenSize;
+done:
+  assert (s->generational.crossMapValidSize == s->heap.oldGenSize);
+  assert (crossMapIsOK (s));
+}
+
+static inline void resizeCardMapAndCrossMap (GC_state s) {
+  if (s->generational.mutatorMarksCards
+      and s->generational.cardMapSize 
+          != align (sizeToCardIndex (s->heap.size), s->pageSize)) {
+    uint8_t *oldCardMap;
+    size_t oldCardMapSize;
+    uint8_t *oldCrossMap;
+    size_t oldCrossMapSize;
+    
+    oldCardMap = s->generational.cardMap;
+    oldCardMapSize = s->generational.cardMapSize;
+    oldCrossMap = s->generational.crossMap;
+    oldCrossMapSize = s->generational.crossMapSize;
+    createCardMapAndCrossMap (s);
+    GC_memcpy ((pointer)oldCrossMap, (pointer)s->generational.crossMap,
+               min (s->generational.crossMapSize, oldCrossMapSize));
+    if (DEBUG_MEM)
+      fprintf (stderr, "Releasing card/cross map.\n");
+    GC_munmap (oldCardMap, oldCardMapSize + oldCrossMapSize);
+  }
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h (from rev 4078, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h	2005-09-12 02:23:11 UTC (rev 4091)
@@ -0,0 +1,21 @@
+/* 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.
+ */
+
+struct GC_generationalInfo {
+  uint8_t *cardMap;
+  uint8_t *cardMapAbsolute;
+  size_t cardMapSize;
+  size_t cardSize;
+  uint8_t *crossMap;
+  size_t crossMapSize;
+  /* crossMapValidEnd is the size of the prefix of the old generation
+   * for which the crossMap is valid.
+   */
+  size_t crossMapValidSize;
+  /*Bool*/bool mutatorMarksCards;
+};

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -22,7 +22,7 @@
 static inline bool pointerIsInOldGen (GC_state s, pointer p) {
   return (not (isPointer (p))
           or (s->heap.start <= p 
-              and p < s->heap.start + s->heap.oldGenBytes));
+              and p < s->heap.start + s->heap.oldGenSize));
 }
 
 static inline bool objptrIsInOldGen (GC_state s, objptr op) {

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h	2005-09-12 02:23:11 UTC (rev 4091)
@@ -19,7 +19,9 @@
 
 typedef struct GC_heap {
   pointer nursery; /* start of nursery */
-  size_t oldGenBytes; /* size of old generation */
+  size_t oldGenSize; /* size of old generation */
   pointer start; /* start of heap (and old generation) */
-  size_t totalBytes; /* size of heap */
+  size_t size; /* size of heap */
 } *GC_heap;
+
+#define LIMIT_SLOP 512

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c (from rev 4089, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-11 16:58:45 UTC (rev 4089)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -0,0 +1,92 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+#if ASSERT
+
+static bool invariant (GC_state s) {
+  if (DEBUG)
+    fprintf (stderr, "invariant\n");
+  // assert (ratiosOk (s));
+  /* Frame layouts */
+  for (unsigned int i = 0; i < s->frameLayoutsSize; ++i) {
+    GC_frameLayout *layout;
+    
+    layout = &(s->frameLayouts[i]);
+    if (layout->numBytes > 0) {
+      GC_frameOffsets offsets;
+      
+      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 (unsigned int j = 0; j < offsets[0]; ++j) */
+/*         assert (offsets[j + 1] < layout->numBytes); */
+    }
+  }
+  /* Generational */
+  if (s->generational.mutatorMarksCards) {
+    assert (s->generational.cardMap == 
+            &s->generational.cardMapAbsolute
+            [pointerToCardIndex(s->heap.start)]);
+    assert (&s->generational.cardMapAbsolute
+            [pointerToCardIndex(s->heap.start + s->heap.size - 1)]
+            < s->generational.cardMap + s->generational.cardMapSize);
+  }
+  assert (isAligned (s->heap.size, s->pageSize));
+  assert (isAligned ((size_t)s->heap.start, s->generational.cardSize));
+  assert (isAlignedFrontier (s, s->heap.start + s->heap.oldGenSize));
+  assert (isAlignedFrontier (s, s->heap.nursery));
+  assert (isAlignedFrontier (s, s->frontier));
+  assert (s->heap.nursery <= s->frontier);
+  unless (0 == s->heap.size) {
+    assert (s->heap.nursery <= s->frontier);
+    assert (s->frontier <= s->limitPlusSlop);
+    assert (s->limit == s->limitPlusSlop - LIMIT_SLOP);
+/*     assert (hasBytesFree (s, 0, 0)); */
+  }
+  assert (s->secondaryHeap.start == NULL or s->heap.size == s->secondaryHeap.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 FALSE
+  if (DEBUG)
+    GC_display (s, stderr);
+  if (frontier)
+    assert (mutatorFrontierInvariant(s));
+  if (stack)
+    assert (mutatorStackInvariant(s));
+#endif
+  assert (invariant (s));
+  return TRUE;
+}
+
+#endif /* #if ASSERT */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -20,30 +20,6 @@
 #define WEAK_GONE_HEADER GC_objectHeader (WEAK_GONE_TYPE_INDEX)
 #define WORD8_VECTOR_HEADER GC_objectHeader (WORD8_TYPE_INDEX)
 
-#define SPLIT_HEADER()                                                          \
-  do {                                                                          \
-    unsigned int objectTypeIndex;                                               \
-    GC_objectType *t;                                                           \
-                                                                                \
-    assert (1 == (header & GC_VALID_HEADER_MASK));                              \
-    objectTypeIndex = (header & TYPE_INDEX_MASK) >> TYPE_INDEX_SHIFT;           \
-    assert (objectTypeIndex < s->objectTypesSize);                              \
-    t = &s->objectTypes [objectTypeIndex];                                      \
-    tag = t->tag;                                                               \
-    hasIdentity = t->hasIdentity;                                               \
-    numNonObjptrs = t->numNonObjptrs;                                           \
-    numObjptrs = t->numObjptrs;                                                 \
-    if (DEBUG_DETAILED)                                                         \
-      fprintf (stderr,                                                          \
-               "SPLIT_HEADER ("FMTHDR")"                                        \
-               "  tag = %s"                                                     \
-               "  hasIdentity = %u"                                             \
-               "  numNonObjptrs = %"PRIu16                                      \
-               "  numObjptrs = %"PRIu16"\n",                                    \
-               header,                                                          \
-               tagToString(tag), hasIdentity, numNonObjptrs, numObjptrs);       \
-  } while (0)
-
 static char* tagToString (GC_objectTypeTag tag) {
   switch (tag) {
   case ARRAY_TAG:
@@ -59,10 +35,50 @@
   }
 }
 
-/* If p points at the beginning of an object, then toData p returns a
- * pointer to the start of the object data.
+static inline void splitHeader(GC_state s, GC_header header,
+                               GC_objectTypeTag *tagRet, bool *hasIdentityRet,
+                               uint16_t *numNonObjptrsRet, uint16_t *numObjptrsRet) {
+  unsigned int objectTypeIndex; 
+  GC_objectType *objectType; 
+  GC_objectTypeTag tag;
+  bool hasIdentity;
+  uint16_t numNonObjptrs, numObjptrs;
+
+  assert (1 == (header & GC_VALID_HEADER_MASK)); 
+  objectTypeIndex = (header & TYPE_INDEX_MASK) >> TYPE_INDEX_SHIFT; 
+  assert (objectTypeIndex < s->objectTypesSize); 
+  objectType = &s->objectTypes [objectTypeIndex]; 
+  tag = objectType->tag; 
+  hasIdentity = objectType->hasIdentity; 
+  numNonObjptrs = objectType->numNonObjptrs; 
+  numObjptrs = objectType->numObjptrs; 
+
+  if (DEBUG_DETAILED) 
+    fprintf (stderr, 
+             "splitHeader ("FMTHDR")" 
+             "  tag = %s" 
+             "  hasIdentity = %u" 
+             "  numNonObjptrs = %"PRIu16 
+             "  numObjptrs = %"PRIu16"\n", 
+             header, 
+             tagToString(tag), hasIdentity, numNonObjptrs, numObjptrs); 
+
+  if (tagRet != NULL)
+    *tagRet = tag;
+  if (hasIdentityRet != NULL)
+    *hasIdentityRet = hasIdentity;
+  if (numNonObjptrsRet != NULL)
+    *numNonObjptrsRet = numNonObjptrs;
+  if (numObjptrsRet != NULL)
+    *numObjptrsRet = numObjptrs;
+}
+
+/* objectData (s, p)
+ *
+ * If p points at the beginning of an object, then objectData returns
+ * a pointer to the start of the object data.
  */
-static inline pointer toData (GC_state s, pointer p) {
+static inline pointer objectData (GC_state s, pointer p) {
   GC_header header;
   pointer res;
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-09-12 02:23:11 UTC (rev 4091)
@@ -12,11 +12,9 @@
   return (0 == ((uintptr_t)p & mask));
 }
 
-static inline void copy (pointer src, pointer dst, size_t size) {
-  unsigned int *to, *from, *limit;
-
+static inline void GC_memcpy (pointer src, pointer dst, size_t size) {
   if (DEBUG_DETAILED)
-    fprintf (stderr, "copy ("FMTPTR", "FMTPTR", %zu)\n",
+    fprintf (stderr, "GC_memcpy ("FMTPTR", "FMTPTR", %zu)\n",
              (uintptr_t)src, (uintptr_t)dst, size);
   assert (isAligned ((uintptr_t)src, sizeof(unsigned int)));
   assert (isAligned ((uintptr_t)dst, sizeof(unsigned int)));
@@ -24,9 +22,5 @@
   assert (dst <= src or src + size <= dst);
   if (src == dst)
     return;
-  from = (unsigned int*)src;
-  to = (unsigned int*)dst;
-  limit = (unsigned int*)(src + size);
-  until (from == limit)
-    *to++ = *from++;
+  memcpy (dst, src, size);
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h	2005-09-12 02:23:11 UTC (rev 4091)
@@ -13,6 +13,8 @@
   uintmax_t bytesHashConsed;
   uintmax_t bytesMarkCompacted;
 
+  uintmax_t markedCards; /* Number of marked cards seen during minor GCs. */
+
   size_t maxBytesLive;
   size_t maxHeapSizeSeen;
   size_t maxStackSizeSeen;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h	2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h	2005-09-12 02:23:11 UTC (rev 4091)
@@ -24,6 +24,7 @@
 #include <inttypes.h>
 #include <stdlib.h>
 #include <limits.h>
+#include <string.h>
 
 #include "../assert.h"
 
@@ -38,6 +39,14 @@
 #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)))

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h (from rev 4089, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h	2005-09-11 16:58:45 UTC (rev 4089)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h	2005-09-12 02:23:11 UTC (rev 4091)
@@ -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.
+ */
+
+void *GC_mmap (void *start, size_t length);
+void *GC_mmapAnon (size_t length);
+void *GC_munmap (void *base, size_t length);

Fixed bug in display of types with large numbers of type variables,
which could cause unhandled exception Chr.


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

U   mlton/trunk/doc/changelog
U   mlton/trunk/mlton/elaborate/type-env.fun

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

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2005-09-11 16:58:45 UTC (rev 4089)
+++ mlton/trunk/doc/changelog	2005-09-11 23:26:29 UTC (rev 4090)
@@ -1,5 +1,9 @@
 Here are the changes since version 20041109.
 
+* 2005-09-11
+  - Fixed bug in display of types with large numbers of type
+    variables, which could cause unhandled exception Chr.
+
 * 2005-09-08
   - Fixed bug in type inference of flexible records that would show up
     as "Type error: variable applied to wrong number of type args"

Modified: mlton/trunk/mlton/elaborate/type-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/type-env.fun	2005-09-11 16:58:45 UTC (rev 4089)
+++ mlton/trunk/mlton/elaborate/type-env.fun	2005-09-11 23:26:29 UTC (rev 4090)
@@ -644,7 +644,13 @@
                        val n = !r
                        val l =
                           simple
-                          (str (concat ["'", Char.toString (Char.fromInt n)]))
+                          (str (concat
+                                ["'",
+                                 if n > Char.toInt #"z" then
+                                    concat ["a",
+                                            Int.toString (n - Char.toInt #"z")]
+                                 else
+                                    Char.toString (Char.fromInt n )]))
                        val _ = r := 1 + n
                     in
                        l

Enabled GC rusage measurement when verbosity isn't silent.


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

U   mlton/trunk/mlton/main/main.fun

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

Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun	2005-09-11 16:58:07 UTC (rev 4088)
+++ mlton/trunk/mlton/main/main.fun	2005-09-11 16:58:45 UTC (rev 4089)
@@ -478,7 +478,7 @@
                           "0" => Silent
                         | "1" => Top
                         | "2" => Pass
-                        | "3" =>  Detail
+                        | "3" => Detail
                         | _ => usage (concat ["invalid -verbose arg: ", s])))),
        (Expert, "warn-ann", " {true|false}",
         "unrecognized annotation warnings",
@@ -517,6 +517,7 @@
           | _ => Error.bug "incorrect args from shell script"
       val _ = setTargetType ("self", usage)
       val result = parse args
+      val () = MLton.GC.setRusage (!verbosity <> Silent)
       val () =
          if !showAnns then
             (Layout.outputl (Control.Elaborate.document {expert = !expert}, 

Exported Socket.

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

U   mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm

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

Modified: mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm
===================================================================
--- mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm	2005-09-11 16:27:05 UTC (rev 4087)
+++ mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm	2005-09-11 16:58:07 UTC (rev 4088)
@@ -53,6 +53,7 @@
 structure RealVector
 structure SML90
 structure SMLofNJ
+structure Socket
 structure String
 structure StringCvt
 structure Substring

Caught up with changes to MLton structure.

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

U   mlton/trunk/lib/mlton-stubs/gc.sig
U   mlton/trunk/lib/mlton-stubs/itimer.sig
U   mlton/trunk/lib/mlton-stubs/mlton.sml
U   mlton/trunk/lib/mlton-stubs/random.sig
U   mlton/trunk/lib/mlton-stubs/rlimit.sig
U   mlton/trunk/lib/mlton-stubs/rusage.sig
U   mlton/trunk/lib/mlton-stubs/signal.sig
U   mlton/trunk/lib/mlton-stubs/socket.sig
U   mlton/trunk/lib/mlton-stubs/syslog.sig
U   mlton/trunk/lib/mlton-stubs/word.sig

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

Modified: mlton/trunk/lib/mlton-stubs/gc.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/gc.sig	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/gc.sig	2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
@@ -10,6 +11,7 @@
       val collect: unit -> unit
       val pack: unit -> unit
       val setMessages: bool -> unit
+      val setRusage: bool -> unit
       val setSummary: bool -> unit
       val unpack: unit -> unit
    end

Modified: mlton/trunk/lib/mlton-stubs/itimer.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/itimer.sig	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/itimer.sig	2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.

Modified: mlton/trunk/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/trunk/lib/mlton-stubs/mlton.sml	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/mlton.sml	2005-09-11 16:27:05 UTC (rev 4087)
@@ -132,6 +132,7 @@
             fun collect _ = ()
             val pack = MLton.GC.pack
             fun setMessages _ = ()
+            fun setRusage _ = ()
             fun setSummary _ = ()
             fun time _ = Time.zeroTime
             fun unpack _ = ()
@@ -478,6 +479,11 @@
                   type t = word
                end
 
+            structure Ctl =
+               struct
+                  fun getERROR _ = NONE
+               end
+
             structure Host =
                struct
                   type t = {name: string}
@@ -495,6 +501,7 @@
                
             fun accept _ = raise Fail "Socket.accept"
             fun connect _ = raise Fail "Socket.connect"
+            fun fdToSock _ = raise Fail "Socket.fdToSock"
             fun listen _ = raise Fail "Socket.listen"
             fun listenAt _ = raise Fail "Socket.listenAt"
             fun shutdownRead _ = raise Fail "Socket.shutdownWrite"

Modified: mlton/trunk/lib/mlton-stubs/random.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/random.sig	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/random.sig	2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.

Modified: mlton/trunk/lib/mlton-stubs/rlimit.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/rlimit.sig	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/rlimit.sig	2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.

Modified: mlton/trunk/lib/mlton-stubs/rusage.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/rusage.sig	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/rusage.sig	2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.

Modified: mlton/trunk/lib/mlton-stubs/signal.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/signal.sig	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/signal.sig	2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.

Modified: mlton/trunk/lib/mlton-stubs/socket.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/socket.sig	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/socket.sig	2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
@@ -15,6 +16,13 @@
             type t = word
          end
 
+      structure Ctl:
+         sig
+            val getERROR:
+               ('af, 'sock_type) Socket.sock
+               -> (string * Posix.Error.syserror option) option
+         end
+
       structure Host:
          sig
             type t = {name: string}
@@ -36,4 +44,6 @@
       val listenAt: Port.t -> t
       val shutdownRead: TextIO.instream -> unit
       val shutdownWrite: TextIO.outstream -> unit
+
+      val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) Socket.sock
    end

Modified: mlton/trunk/lib/mlton-stubs/syslog.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/syslog.sig	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/syslog.sig	2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.

Modified: mlton/trunk/lib/mlton-stubs/word.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/word.sig	2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/word.sig	2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.

Fixed Subscript bug in signature matching.

The bug was tickled by the following program, which caused an
unhandled exception to be raised.

  signature X =
     sig
        type x = unit
     end
  
  structure X :> X =
     struct
        type 'a x = unit
     end

The problem was in the isPlausible function, introduced back in
revision 3744.  It was checking schemes too early, under the
assumption that the type arities were equal, rather than waiting until
after the check that verified that they were (which in the above case
would fail).  The fix was to delay the checkSchemes call until after
isPlausible succeeds.


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

U   mlton/trunk/mlton/elaborate/elaborate-env.fun

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

Modified: mlton/trunk/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-env.fun	2005-09-09 23:29:50 UTC (rev 4085)
+++ mlton/trunk/mlton/elaborate/elaborate-env.fun	2005-09-11 16:18:55 UTC (rev 4086)
@@ -2673,18 +2673,26 @@
                         Datatype {cons = sigCons, ...} =>
                            (case TypeStr.node structStr of
                                Datatype {cons = structCons, ...} =>
-                                  (checkCons (structCons, sigCons, strids, name)
-                                   ; (structStr, false))
-                             | _ => (sigStr, true))
-                      | Scheme s => (checkScheme s; (sigStr, false))
-                      | Tycon c => (checkScheme (tyconScheme c); (sigStr, false))
+                                  (fn () =>
+                                   (checkCons (structCons, sigCons, strids,
+                                               name)
+                                    ; structStr),
+                                   false)
+                             | _ => (fn () => sigStr, true))
+                      | Scheme s =>
+                           (fn () => (checkScheme s; sigStr),
+                            false)
+                      | Tycon c =>
+                           (fn () => (checkScheme (tyconScheme c); sigStr),
+                            false)
                in
-                  if not (isPlausible (structStr, strids, name,
-                                       TypeStr.admitsEquality sigStr,
-                                       TypeStr.kind sigStr,
-                                       consMismatch))
-                     then sigStr
-                  else return
+                  if isPlausible (structStr, strids, name,
+                                  TypeStr.admitsEquality sigStr,
+                                  TypeStr.kind sigStr,
+                                  consMismatch) then
+                     return ()
+                  else
+                     sigStr
                end
       fun map (structInfo: ('a, 'b) Info.t,
                sigArray: ('a * 'c) array,

(Mostly) converted cheneyCopy; missing rusage and card/cross map stuff
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/major.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-09 22:48:09 UTC (rev 4084)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-09 23:29:50 UTC (rev 4085)
@@ -89,6 +89,8 @@
 	stack.h								\
 	thread.h							\
 	weak.h								\
+	major.h								\
+	statistics.h							\
 	heap.h								\
 	gc_state.h							\
 	gc_suffix.h

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-09 22:48:09 UTC (rev 4084)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-09 23:29:50 UTC (rev 4085)
@@ -183,7 +183,7 @@
   s->weaks = NULL;
 }
 
-static inline void swapSemis (GC_state s) {
+static inline void swapHeaps (GC_state s) {
   struct GC_heap tempHeap;
   
   tempHeap = s->secondaryHeap;
@@ -196,46 +196,47 @@
 /*         return s->summary; */
 /* } */
 
-/* static void cheneyCopy (GC_state s) { */
-/*         struct rusage ru_start; */
-/*         pointer toStart; */
+static void majorCheneyCopyGC (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->secondaryHeap.start; */
-/*         s->toLimit = s->secondaryHeap.start + s->secondaryHeap.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"); */
-/* } */
+  assert (s->secondaryHeap.totalBytes >= s->heap.oldGenBytes);
+/*   if (detailedGCTime (s)) */
+/*     startTiming (&ru_start); */
+  s->cumulative.numCopyingGCs++;
+  forwardState.toStart = s->secondaryHeap.start;
+  forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.totalBytes;
+  if (DEBUG or s->messages) {
+    fprintf (stderr, "Major copying GC.\n");
+    fprintf (stderr, "fromSpace = "FMTPTR" of size %zd\n",
+             (uintptr_t) s->heap.start, 
+             /*uintToCommaString*/(s->heap.totalBytes));
+    fprintf (stderr, "toSpace = "FMTPTR" of size %zd\n",
+             (uintptr_t) s->secondaryHeap.start, 
+             /*uintToCommaString*/(s->secondaryHeap.totalBytes));
+  }
+  assert (s->secondaryHeap.start != (pointer)NULL);
+  /* The next assert ensures there is enough space for the copy to
+   * succeed.  It does not assert 
+   *   (s->secondaryHeap.totalBytes >= s->heap.totalByes) 
+   * because that is too strong.
+   */
+  assert (s->secondaryHeap.totalBytes >= s->heap.oldGenBytes);
+  toStart = alignFrontier (s, s->secondaryHeap.start);
+  forwardState.back = toStart;
+  foreachGlobalObjptr (s, forward);
+  foreachObjptrInRange (s, toStart, &forwardState.back, TRUE, forward);
+  updateWeaks (s);
+  s->secondaryHeap.oldGenBytes = forwardState.back - s->secondaryHeap.start;
+  s->cumulative.bytesCopied += s->secondaryHeap.oldGenBytes;
+  if (DEBUG)
+    fprintf (stderr, "%zd bytes live.\n",
+             /*uintToCommaString*/(s->secondaryHeap.oldGenBytes));
+  swapHeaps (s);
+  // clearCrossMap (s);
+  s->lastMajor.kind = GC_COPYING;
+/*   if (detailedGCTime (s)) */
+/*     stopTiming (&ru_start, &s->ru_gcCopy); */
+  if (DEBUG or s->messages)
+    fprintf (stderr, "Major copying GC done.\n");
+}

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-09-09 22:48:09 UTC (rev 4084)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-09-09 23:29:50 UTC (rev 4085)
@@ -4,6 +4,7 @@
   bool amInGC;
   bool amInMinorGC;
   objptr callFromCHandler; /* Handler for exported C calls (in heap). */
+  struct GC_cumulativeStatistics cumulative;
   objptr currentThread; /* Currently executing thread (in heap). */
   GC_frameLayout *frameLayouts; /* Array of frame layouts. */
   uint32_t frameLayoutsSize; /* Cardinality of frameLayouts array. */
@@ -11,6 +12,7 @@
   objptr *globals;
   uint32_t globalsSize;
   struct GC_heap heap;
+  struct GC_lastMajorStatistics lastMajor;
   pointer limit; /* limit = heap.start + heap.totalBytes */
   uint32_t maxFrameSize;
   GC_objectType *objectTypes; /* Array of object types. */
@@ -24,6 +26,7 @@
   pointer stackBottom; /* Bottom of stack in current thread. */
   pointer stackTop; /* Top of stack in current thread. */
   /*Bool*/bool summary; /* Print a summary of gc info when program exits. */
+  /*Bool*/bool messages; /* Print a message at the start and end of each gc. */
   float threadShrinkRatio;
   GC_weak weaks; /* Linked list of (live) weak pointers */
 } *GC_state;

Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-09-09 22:48:09 UTC (rev 4084)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c	2005-09-09 23:29:50 UTC (rev 4085)
@@ -0,0 +1,47 @@
+/* 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.
+ */
+
+static inline bool pointerIsInHeap (GC_state s, pointer p) {
+  return (not (isPointer (p))
+          or (s->heap.start <= p 
+              and p < s->frontier));
+}
+
+static inline bool objptrIsInHeap (GC_state s, objptr op) {
+  pointer p;
+  if (not (isObjptr(op)))
+    return TRUE;
+  p = objptrToPointer (op, s->heap.start);
+  return pointerIsInHeap (s, p);
+}
+
+static inline bool pointerIsInOldGen (GC_state s, pointer p) {
+  return (not (isPointer (p))
+          or (s->heap.start <= p 
+              and p < s->heap.start + s->heap.oldGenBytes));
+}
+
+static inline bool objptrIsInOldGen (GC_state s, objptr op) {
+  pointer p;
+  if (not (isObjptr(op)))
+    return TRUE;
+  p = objptrToPointer (op, s->heap.start);
+  return pointerIsInOldGen (s, p);
+}
+
+static inline bool pointerIsInNursery (GC_state s, pointer p) {
+  return (not (isPointer (p))
+          or (s->heap.nursery <= p and p < s->frontier));
+}
+
+static inline bool objptrIsInNursery (GC_state s, objptr op) {
+  pointer p;
+  if (not (isObjptr(op)))
+    return TRUE;
+  p = objptrToPointer (op, s->heap.start);
+  return pointerIsInNursery (s, p);
+}

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/major.h (from rev 4078, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/major.h	2005-09-09 23:29:50 UTC (rev 4085)
@@ -0,0 +1,12 @@
+/* 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 enum {
+        GC_COPYING,
+        GC_MARK_COMPACT,
+} GC_MajorKind;

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h (from rev 4078, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h	2005-09-09 23:29:50 UTC (rev 4085)
@@ -0,0 +1,40 @@
+/* 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.
+ */
+
+struct GC_cumulativeStatistics {
+  uintmax_t bytesAllocated;
+  uintmax_t bytesCopied;
+  uintmax_t bytesCopiedMinor;
+  uintmax_t bytesHashConsed;
+  uintmax_t bytesMarkCompacted;
+
+  size_t maxBytesLive;
+  size_t maxHeapSizeSeen;
+  size_t maxStackSizeSeen;
+
+  uintmax_t minorBytesScanned;
+  uintmax_t minorBytesSkipped;
+
+  uintmax_t numLimitChecks;
+
+  unsigned int numCopyingGCs;
+  unsigned int numHashConsGCs;
+  unsigned int numMarkCompactGCs;
+  unsigned int numMinorGCs;
+
+/*   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. *\/ */
+};
+
+struct GC_lastMajorStatistics {
+  size_t bytesLive; /* Number of bytes live at most recent major GC. */
+  GC_MajorKind kind;
+  unsigned int numMinorsGCs;
+};

Filling in forward assertion predicates
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-09 21:56:06 UTC (rev 4083)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-09 22:48:09 UTC (rev 4084)
@@ -71,6 +71,7 @@
 	frame.c								\
 	stack.c								\
 	thread.c							\
+	heap.c   							\
 	foreach.c							\
 	cheney-copy.c							\
 	assumptions.c							\

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-09 21:56:06 UTC (rev 4083)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-09 22:48:09 UTC (rev 4084)
@@ -19,12 +19,33 @@
  */
 struct forwardState {
   pointer back;
-  pointer fromBase;
-  pointer toBase;
+  pointer toStart;
   pointer toLimit;
 };
 static struct forwardState forwardState;
 
+static inline bool pointerIsInFromSpace (GC_state s, pointer p) {
+  return (pointerIsInOldGen (s, p) or pointerIsInNursery (s, p));
+}
+
+static inline bool objptrIsInFromSpace (GC_state s, objptr op) {
+  return (objptrIsInOldGen (s, op) or objptrIsInNursery (s, op));
+}
+
+static inline bool pointerIsInToSpace (pointer p) {
+  return (not (isPointer (p))
+          or (forwardState.toStart <= p and p < forwardState.toLimit));
+}
+
+static inline bool objptrIsInToSpace (objptr op) {
+  pointer p;
+
+  if (not (isObjptr (op)))
+    return TRUE;
+  p = objptrToPointer (op, forwardState.toStart);
+  return pointerIsInToSpace (p);
+}
+
 static inline void forward (GC_state s, objptr *opp) {
   objptr op;
   pointer p;
@@ -32,12 +53,12 @@
   GC_objectTypeTag tag;
 
   op = *opp;
-  p = objptrToPointer (op, forwardState.fromBase);
+  p = objptrToPointer (op, s->heap.start);
   if (DEBUG_DETAILED)
     fprintf (stderr,
              "forward  opp = "FMTPTR"  op = "FMTOBJPTR"  p = "FMTPTR"\n",
              (uintptr_t)opp, op, (uintptr_t)p);
-  // assert (isInFromSpace (s, *pp));
+  assert (objptrIsInFromSpace (s, *opp));
   header = getHeader (p);
   if (DEBUG_DETAILED and header == GC_FORWARDED)
     fprintf (stderr, "  already FORWARDED\n");
@@ -82,18 +103,17 @@
           if (new <= stack->reserved) {
             stack->reserved = new;
             if (DEBUG_STACKS)
-              fprintf (stderr, "Shrinking stack to size %"PRId32".\n",
+              fprintf (stderr, "Shrinking stack to size %zd.\n",
                        /*uintToCommaString*/(stack->reserved));
           }
         }
       } else {
-        /* Shrink heap stacks.
-         */
+        /* Shrink heap stacks. */
         stack->reserved = 
           stackReserved (s, maxZ((size_t)(s->threadShrinkRatio * stack->reserved),
                                  stack->used));
         if (DEBUG_STACKS)
-          fprintf (stderr, "Shrinking stack to size %"PRId32".\n",
+          fprintf (stderr, "Shrinking stack to size %zd.\n",
                    /*uintToCommaString*/(stack->reserved));
       }
       objectBytes = sizeof (struct GC_stack) + stack->used;
@@ -115,7 +135,7 @@
                  (uintptr_t)w);
       if (isObjptr (w->objptr)
           and (not s->amInMinorGC
-               or isInNursery (s, w->objptr))) {
+               or objptrIsInNursery (s, w->objptr))) {
         if (DEBUG_WEAK)
           fprintf (stderr, "linking\n");
         w->link = s->weaks;
@@ -127,14 +147,14 @@
     }
     /* Store the forwarding pointer in the old object. */
     *(GC_header*)(p - GC_HEADER_SIZE) = GC_FORWARDED;
-    *(objptr*)p = pointerToObjptr(forwardState.back + headerBytes, forwardState.toBase);
+    *(objptr*)p = pointerToObjptr(forwardState.back + headerBytes, forwardState.toStart);
     /* Update the back of the queue. */
     forwardState.back += size + skip;
     assert (isAligned ((uintptr_t)forwardState.back + GC_NORMAL_HEADER_SIZE, 
                        s->alignment));
   }
   *opp = *(objptr*)p;
-  // assert (isInToSpace (s, *opp));
+  assert (objptrIsInToSpace (*opp));
 }
 
 static inline void updateWeaks (GC_state s) {
@@ -146,7 +166,7 @@
 
     if (DEBUG_WEAK)
       fprintf (stderr, "updateWeaks  w = "FMTPTR"  ", (uintptr_t)w);
-    p = objptrToPointer (w->objptr, forwardState.fromBase);
+    p = objptrToPointer (w->objptr, s->heap.start);
     if (GC_FORWARDED == getHeader (p)) {
       if (DEBUG_WEAK)
         fprintf (stderr, "forwarded from "FMTOBJPTR" to "FMTOBJPTR"\n",

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-09-09 21:56:06 UTC (rev 4083)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-09-09 22:48:09 UTC (rev 4084)
@@ -7,9 +7,11 @@
   objptr currentThread; /* Currently executing thread (in heap). */
   GC_frameLayout *frameLayouts; /* Array of frame layouts. */
   uint32_t frameLayoutsSize; /* Cardinality of frameLayouts array. */
+  pointer frontier; /* heap.start <= frontier < limit */
   objptr *globals;
   uint32_t globalsSize;
   struct GC_heap heap;
+  pointer limit; /* limit = heap.start + heap.totalBytes */
   uint32_t maxFrameSize;
   GC_objectType *objectTypes; /* Array of object types. */
   uint32_t objectTypesSize; /* Cardinality of objectTypes array. */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h	2005-09-09 21:56:06 UTC (rev 4083)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h	2005-09-09 22:48:09 UTC (rev 4084)
@@ -10,14 +10,16 @@
  * All ML objects (including ML execution stacks) are allocated in a
  * contiguous heap.  The heap has the following general layout:
  * 
- * ---------------------------------------------------
- * |                                                 |
- * ---------------------------------------------------
- * ^
- * start
+ *  ---------------------------------------------------
+ *  |    old generation    |              |  nursery  |
+ *  ---------------------------------------------------
+ *  ^                                     ^
+ *  start                                 nursery
 */
 
 typedef struct GC_heap {
-  size_t numBytes; /* size of heap */
-  pointer start; /* start of heap */
+  pointer nursery; /* start of nursery */
+  size_t oldGenBytes; /* size of old generation */
+  pointer start; /* start of heap (and old generation) */
+  size_t totalBytes; /* size of heap */
 } *GC_heap;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h	2005-09-09 21:56:06 UTC (rev 4083)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h	2005-09-09 22:48:09 UTC (rev 4084)
@@ -37,11 +37,11 @@
   /* reserved is the number of bytes reserved for stack, 
    * i.e. its maximum size.
    */
-  uint32_t reserved;
+  size_t reserved;
   /* used is the number of bytes used by the stack.  
    * Stacks with used == reserved are continuations.
    */
-  uint32_t used;      
+  size_t used;      
   /* The next address is the bottom of the stack, and the following
    * reserved bytes hold space for the stack.
    */

Include more gcc warnings
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.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
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-09 21:56:06 UTC (rev 4083)
@@ -49,8 +49,15 @@
 endif
 
 CC = gcc -std=gnu99
-CFLAGS = -O2 -Wall -I. -D_FILE_OFFSET_BITS=64 $(FLAGS)
-DEBUGFLAGS = $(CFLAGS) -gstabs+ -g2
+CWFLAGS = -Wall -pedantic -Wextra -Wshadow -Wpointer-arith -Wcast-qual -Wcast-align -Wconversion -Wsign-compare -Wstrict-prototypes -Wredundant-decls -Winline
+CWFLAGS = -pedantic -Wall -Wextra -Wno-unused \
+	-Wshadow -Wredundant-decls \
+	-Wpointer-arith -Wcast-qual -Wcast-align \
+##	-Wconversion \
+	-Wstrict-prototypes \
+	-Winline
+CFLAGS = -O2 $(CWFLAGS) -I. -D_FILE_OFFSET_BITS=64 $(FLAGS)
+DEBUGFLAGS = $(CFLAGS) -Wunused -gstabs+ -g2
 
 ## Order matters, as these are concatenated together to form "gc.c".
 CFILES = 								\

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-09-09 21:56:06 UTC (rev 4083)
@@ -7,7 +7,6 @@
  */
 
 static inline size_t align (size_t a, size_t b) {
-  assert (a >= 0);
   assert (b >= 1);
   a += b - 1;
   a -= a % b;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-09-09 21:56:06 UTC (rev 4083)
@@ -21,13 +21,15 @@
   SPLIT_HEADER();
   assert (tag == ARRAY_TAG);
 
+  size_t nonObjptrBytesPerElement =
+    numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
   size_t bytesPerElement = 
-    numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG) 
+    nonObjptrBytesPerElement
     + (numObjptrs * OBJPTR_SIZE);
 
   return a
     + arrayIndex * bytesPerElement
-    + numNonObjptrsToBytes(numNonObjptrs, tag) 
+    + nonObjptrBytesPerElement
     + pointerIndex * OBJPTR_SIZE;
 }
 #endif

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c	2005-09-09 21:56:06 UTC (rev 4083)
@@ -11,7 +11,7 @@
  * but which are reasonable to assume on a wide variety of target
  * platforms.  Working around these assumptions would be difficult.
  */
-void checkAssumptions () {
+void checkAssumptions (void) {
   assert(CHAR_BIT == 8);
   /* assert(repof(uintptr_t) == TWOS); */
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-09 21:56:06 UTC (rev 4083)
@@ -90,7 +90,7 @@
         /* Shrink heap stacks.
          */
         stack->reserved = 
-          stackReserved (s, maxZ(s->threadShrinkRatio * stack->reserved,
+          stackReserved (s, maxZ((size_t)(s->threadShrinkRatio * stack->reserved),
                                  stack->used));
         if (DEBUG_STACKS)
           fprintf (stderr, "Shrinking stack to size %"PRId32".\n",
@@ -106,7 +106,7 @@
     /* 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 numObjptrs == 1) {
+    if ((WEAK_TAG == tag) and (numObjptrs == 1)) {
       GC_weak w;
       
       w = (GC_weak)(forwardState.back + GC_NORMAL_HEADER_SIZE);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-09 21:56:06 UTC (rev 4083)
@@ -153,7 +153,7 @@
         fprintf (stderr, "  top = "FMTPTR"  return address = "FMTPTR"\n",
                  (uintptr_t)top, returnAddress);
       }
-      frameLayout = getFrameLayout (s, returnAddress);
+      frameLayout = getFrameLayoutFromReturnAddress (s, returnAddress);
       frameOffsets = frameLayout->offsets;
       top -= frameLayout->numBytes;
       for (i = 0 ; i < frameOffsets[0] ; ++i) {

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c	2005-09-09 21:56:06 UTC (rev 4083)
@@ -6,7 +6,8 @@
  * See the file MLton-LICENSE for details.
  */
 
-static inline uint32_t getFrameIndex (GC_state s, GC_returnAddress ra) {
+static inline uint32_t 
+getFrameIndexFromReturnAddress (GC_state s, GC_returnAddress ra) {
   uint32_t res;
 
   res = s->returnAddressToFrameIndex (ra);
@@ -16,19 +17,27 @@
   return res;
 }
 
-static inline GC_frameLayout * getFrameLayout (GC_state s, GC_returnAddress ra) {
+static inline GC_frameLayout * 
+getFrameLayoutFromFrameIndex (GC_state s, uint32_t index) {
   GC_frameLayout *layout;
-  uint32_t index;
 
-  index = getFrameIndex (s, ra);
   if (DEBUG_DETAILED)
     fprintf (stderr, 
-             "returnAddress = "FMTRA
-             "  index = %"PRIx32
+             "index = %"PRIx32
              "  frameLayoutsSize = %"PRIu16"\n",
-             ra, index, s->frameLayoutsSize);
-  assert (0 <= index and index < s->frameLayoutsSize);
+            index, s->frameLayoutsSize);
+  assert (index < s->frameLayoutsSize);
   layout = &(s->frameLayouts[index]);
   assert (layout->numBytes > 0);
   return layout;
 }
+
+static inline GC_frameLayout * 
+getFrameLayoutFromReturnAddress (GC_state s, GC_returnAddress ra) {
+  GC_frameLayout *layout;
+  uint32_t index;
+  
+  index = getFrameIndexFromReturnAddress (s, ra);
+  layout = getFrameLayoutFromFrameIndex(s, index);
+  return layout;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c	2005-09-09 21:56:06 UTC (rev 4083)
@@ -73,6 +73,6 @@
 static inline void storeObjptrFromPointer (pointer OP, pointer P, pointer B) {
   *((objptr*)OP) = pointerToObjptr (P, B);
 }
-static inline size_t objptrSize () {
+static inline size_t objptrSize (void) {
   return OBJPTR_SIZE;
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c	2005-09-09 21:56:06 UTC (rev 4083)
@@ -22,13 +22,12 @@
 
 #define SPLIT_HEADER()                                                          \
   do {                                                                          \
-    int objectTypeIndex;                                                        \
+    unsigned int objectTypeIndex;                                               \
     GC_objectType *t;                                                           \
                                                                                 \
-    assert (1 == (header & 1));                                                 \
+    assert (1 == (header & GC_VALID_HEADER_MASK));                              \
     objectTypeIndex = (header & TYPE_INDEX_MASK) >> TYPE_INDEX_SHIFT;           \
-    assert (0 <= objectTypeIndex                                                \
-            and objectTypeIndex < s->objectTypesSize);                          \
+    assert (objectTypeIndex < s->objectTypesSize);                              \
     t = &s->objectTypes [objectTypeIndex];                                      \
     tag = t->tag;                                                               \
     hasIdentity = t->hasIdentity;                                               \

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2005-09-09 21:56:06 UTC (rev 4083)
@@ -30,18 +30,18 @@
 #define GC_HEADER_SIZE sizeof(GC_header)
 #define PRIxHDR PRIx32
 #define FMTHDR "0x%08"PRIxHDR
-enum {
-  TYPE_INDEX_BITS =  19,
-  TYPE_INDEX_MASK =  0x000FFFFE,
-  TYPE_INDEX_SHIFT = 1,
-  COUNTER_BITS =     10,
-  COUNTER_MASK =     0x7FF00000,
-  COUNTER_SHIFT =    20,
-  MARK_BITS =        1,
-  MARK_MASK =        0x80000000,
-  MARK_SHIFT =       31
-};
 
+#define GC_VALID_HEADER_MASK ((GC_header)0x1)
+#define TYPE_INDEX_BITS    19
+#define TYPE_INDEX_MASK    0x000FFFFE
+#define TYPE_INDEX_SHIFT   1
+#define COUNTER_BITS       10
+#define COUNTER_MASK       0x7FF00000
+#define COUNTER_SHIFT      20
+#define MARK_BITS          1
+#define MARK_MASK          0x80000000
+#define MARK_SHIFT         3
+
 /* getHeaderp (p)
  *
  * Returns a pointer to the header for the object pointed to by p.

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-09-09 05:50:10 UTC (rev 4082)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-09-09 21:56:06 UTC (rev 4083)
@@ -47,9 +47,9 @@
 static inline uint32_t topFrameIndex (GC_state s, GC_stack stack) {
   uint32_t res;
 
-  res = getFrameIndex (s, 
-                       *(GC_returnAddress*)
-                       (stackTop (s, stack) - GC_RETURNADDRESS_SIZE));
+  res = 
+    getFrameIndexFromReturnAddress 
+    (s, *(GC_returnAddress*)(stackTop (s, stack) - GC_RETURNADDRESS_SIZE));
   if (DEBUG_PROFILE)
     fprintf (stderr, "topFrameIndex = %"PRIu32"\n", res);
   return res;
@@ -58,7 +58,7 @@
 static inline GC_frameLayout * topFrameLayout (GC_state s, GC_stack stack) {
   GC_frameLayout *layout;
 
-  layout = getFrameLayout (s, topFrameIndex (s, stack));
+  layout = getFrameLayoutFromFrameIndex (s, topFrameIndex (s, stack));
   return layout;
 }
 

MAIL fixed bug in flexible record type inference

The bug was tickled by the following program.

  val g = fn {...} => ()
  and h = fn () => ()
  val () = (h (); g {a = 13})

The bug showed as an IL type error indicating that "h" was applied to
the wrong number of type arguments.  The problem was that the
declaration of "h" expected one type argument but the application had
none.

The extra type variable arises because of the generalized flexrecord
in the type of g (note that the bug goes away without the "and").  The
bug was that type variable was not instantiated at the use of "h"
because the genflex did not occur in the type of h.  Prior to r3799,
this would have raised an internal bug message ("missing flexInst"),
and indeed this is what happens if you run MLton 20041109 on the
example.  However, in r3799, we removed the bug message and replaced
it with code that would silently continue, under the mistaken
impression that any genflexrecord must have had an instance, or the
user code must have already shown a type error.  This fix missed
exactly the case above.

The correct fix is to instantiate *all* genflexrecords that occur in
any type in the declaration, whether or not they actually occur in the
type of the function.  In the simple case above, that means that h
does get the extra type argument (unit) corresponding to the flexible
record field "a" in the argument to "g".

This fix also handles the problem that led to r3799, because the
missing flexinst will still be silently instantiated.

As a side note, only Poly/ML and MLton are able to infer the simple
example above.  Hamlet, Moscow ML, ML Kit, and SML/NJ all report
unresolved flexible record types.


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

U   mlton/trunk/doc/changelog
U   mlton/trunk/mlton/elaborate/type-env.fun
U   mlton/trunk/regression/flexrecord.sml

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

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2005-09-09 05:27:33 UTC (rev 4081)
+++ mlton/trunk/doc/changelog	2005-09-09 05:50:10 UTC (rev 4082)
@@ -1,5 +1,9 @@
 Here are the changes since version 20041109.
 
+* 2005-09-08
+  - Fixed bug in type inference of flexible records that would show up
+    as "Type error: variable applied to wrong number of type args"
+
 * 2005-09-06
   - Fixed bug in Real.signBit, which had assumed that the underlying
     C signbit returned 0 or 1, when in fact any nonzero value is

Modified: mlton/trunk/mlton/elaborate/type-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/type-env.fun	2005-09-09 05:27:33 UTC (rev 4081)
+++ mlton/trunk/mlton/elaborate/type-env.fun	2005-09-09 05:50:10 UTC (rev 4082)
@@ -1488,42 +1488,46 @@
                      (List.fold
                       (flexes, Vector.toList types,
                        fn ({fields, spine, ...}, ac) =>
-                       Exn.withEscape (fn escape =>
                        let
-                          val flex =
-                             case List.peek (flexInsts,
-                                             fn {spine = spine', ...} =>
-                                             Spine.equals (spine, spine')) of
-                                NONE => escape ac (* Error.bug "missing flexInst" *)
-                              | SOME {flex, ...} => flex
-                          fun peekFields (fields, f) =
-                             Option.map
-                             (List.peek (fields, fn (f', _) =>
-                                         Field.equals (f, f')),
-                              #2)
-                          val peek =
-                             case Type.toType flex of
-                                FlexRecord {fields, ...} =>
-                                   (fn f => peekFields (fields, f))
-                              | GenFlexRecord {extra, fields, ...} =>
-                                   (fn f =>
-                                    case peekFields (fields, f) of
-                                       NONE =>
-                                          Option.map
-                                          (List.peek
-                                           (extra (), fn {field, ...} =>
-                                            Field.equals (f, field)),
-                                           Type.var o #tyvar)
-                                     | SOME t => SOME t)
-                              | Record r => (fn f => Srecord.peek (r, f))
-                              | _ => Error.bug "TypeEnv.instantiate': General:strange flexInst"
+                          fun done peek =
+                             Spine.foldOverNew
+                             (spine, fields, ac, fn (f, ac) =>
+                              (case peek f of
+                                  NONE => Type.unit
+                                | SOME t => t) :: ac)
                        in
-                          Spine.foldOverNew
-                          (spine, fields, ac, fn (f, ac) =>
-                           (case peek f of
-                               NONE => Type.unit
-                             | SOME t => t) :: ac)
-                       end)))
+                          case List.peek (flexInsts,
+                                          fn {spine = spine', ...} =>
+                                          Spine.equals (spine, spine')) of
+                             NONE => done (fn _ => NONE)
+                           | SOME {flex, ...} =>
+                                let
+                                   fun peekFields (fields, f) =
+                                      Option.map
+                                      (List.peek (fields, fn (f', _) =>
+                                                  Field.equals (f, f')),
+                                       #2)
+                                in
+                                   done
+                                   (case Type.toType flex of
+                                      FlexRecord {fields, ...} =>
+                                         (fn f => peekFields (fields, f))
+                                    | GenFlexRecord {extra, fields, ...} =>
+                                         (fn f =>
+                                          case peekFields (fields, f) of
+                                             NONE =>
+                                                Option.map
+                                                (List.peek
+                                                 (extra (),
+                                                  fn {field, ...} =>
+                                                  Field.equals (f, field)),
+                                                 Type.var o #tyvar)
+                                           | SOME t => SOME t)
+                                    | Record r =>
+                                         (fn f => Srecord.peek (r, f))
+                                    | _ => Error.bug "TypeEnv.instantiate': General:strange flexInst")
+                                end
+                       end))
                in
                   {args = args,
                    instance = ty}

Modified: mlton/trunk/regression/flexrecord.sml
===================================================================
--- mlton/trunk/regression/flexrecord.sml	2005-09-09 05:27:33 UTC (rev 4081)
+++ mlton/trunk/regression/flexrecord.sml	2005-09-09 05:50:10 UTC (rev 4082)
@@ -93,3 +93,9 @@
       ()
    end
 (* flexrecord8 *)
+
+(* flexrecord9 *)
+val g = fn {...} => ()
+and h = fn () => ()
+val () = (h (); g {a = 13})
+(* flexrecord9 *)

Added mlton-flags.

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

U   mlton/trunk/ide/emacs/mlton.el

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

Modified: mlton/trunk/ide/emacs/mlton.el
===================================================================
--- mlton/trunk/ide/emacs/mlton.el	2005-09-09 02:56:17 UTC (rev 4080)
+++ mlton/trunk/ide/emacs/mlton.el	2005-09-09 05:27:33 UTC (rev 4081)
@@ -10,6 +10,7 @@
 ;; markers so that file edits don't interfere with locating subsequent errros.
 
 (setq mlton-command "mlton")
+(setq mlton-flags "")
 (setq mlton-main-file "mlton-main-file undefined")
 (setq mlton-output-buffer "*mlton-output*")
 (setq mlton-errors nil)
@@ -95,6 +96,7 @@
         (kill-buffer mlton-output-buffer))
     (find-file mlton-main-file)
     (shell-command (concat mlton-command
+                           " " mlton-flags " "
                            " -stop tc "
                            (file-name-nondirectory mlton-main-file))
                    mlton-output-buffer)

Converted forward and updateWeaks
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.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
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-09 02:56:17 UTC (rev 4080)
@@ -56,14 +56,16 @@
 CFILES = 								\
 	gc_prefix.c							\
 	debug.c								\
+	align.c								\
 	pointer.c							\
-	align.c								\
 	model.c								\
 	object.c							\
 	array.c								\
 	frame.c								\
 	stack.c								\
+	thread.c							\
 	foreach.c							\
+	cheney-copy.c							\
 	assumptions.c							\
 	gc_suffix.c
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c	2005-09-09 02:56:17 UTC (rev 4080)
@@ -10,200 +10,212 @@
 /*                    Cheney Copying Collection                     */
 /* ---------------------------------------------------------------- */
 
-/* forward (s, pp) forwards the object pointed to by *pp and updates *pp to 
- * point to the new object. 
+#define GC_FORWARDED ~((GC_header)0)
+
+/* forward (s, opp) 
+ * Forwards the object pointed to by *opp and updates *opp to point to
+ * the new object.  
  * It also updates the crossMap.
  */
-static inline void forward (GC_state s, pointer *pp) {
+struct forwardState {
+  pointer back;
+  pointer fromBase;
+  pointer toBase;
+  pointer toLimit;
+};
+static struct forwardState forwardState;
+
+static inline void forward (GC_state s, objptr *opp) {
+  objptr op;
   pointer p;
-  GC_ObjectHeader header;
-  GC_ObjectTypeTag tag;
+  GC_header header;
+  GC_objectTypeTag tag;
 
+  op = *opp;
+  p = objptrToPointer (op, forwardState.fromBase);
   if (DEBUG_DETAILED)
-    fprintf (stderr, 
-             "forward  pp = 0x"PRIxPTR"  *pp = 0x"PRIxPTR"\n", 
-             pp, *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;
+    fprintf (stderr,
+             "forward  opp = "FMTPTR"  op = "FMTOBJPTR"  p = "FMTPTR"\n",
+             (uintptr_t)opp, op, (uintptr_t)p);
+  // assert (isInFromSpace (s, *pp));
+  header = getHeader (p);
+  if (DEBUG_DETAILED and header == GC_FORWARDED)
+    fprintf (stderr, "  already FORWARDED\n");
+  if (header != GC_FORWARDED) { /* forward the object */
+    bool hasIdentity;
+    uint16_t numNonObjptrs, numObjptrs;
+    size_t headerBytes, objectBytes, size, skip;
 
-                /* 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;
+    /* Compute the space taken by the header and object body. */
+    SPLIT_HEADER();
+    if ((NORMAL_TAG == tag) or (WEAK_TAG == tag)) { /* Fixed size object. */
+      headerBytes = GC_NORMAL_HEADER_SIZE;
+      objectBytes = 
+        numNonObjptrsToBytes(numNonObjptrs, NORMAL_TAG)
+        + (numObjptrs * OBJPTR_SIZE);
+      skip = 0;
+    } else if (ARRAY_TAG == tag) {
+      headerBytes = GC_ARRAY_HEADER_SIZE;
+      objectBytes = arrayNumBytes (s, p, numObjptrs, numNonObjptrs);
+      skip = 0;
+    } else { /* Stack. */
+      GC_stack stack;
 
-                        assert (STACK_TAG == tag);
-                        headerBytes = STACK_HEADER_SIZE;
-                        stack = (GC_stack)p;
+      assert (STACK_TAG == tag);
+      headerBytes = GC_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));
+      if (currentThreadStack(s) == op) {
+        /* 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) {
+          size_t new = 
+            stackReserved (s, maxZ (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 %"PRId32".\n",
+                       /*uintToCommaString*/(stack->reserved));
+          }
         }
-        *pp = *(pointer*)p;
-        assert (isInToSpace (s, *pp));
+      } else {
+        /* Shrink heap stacks.
+         */
+        stack->reserved = 
+          stackReserved (s, maxZ(s->threadShrinkRatio * stack->reserved,
+                                 stack->used));
+        if (DEBUG_STACKS)
+          fprintf (stderr, "Shrinking stack to size %"PRId32".\n",
+                   /*uintToCommaString*/(stack->reserved));
+      }
+      objectBytes = sizeof (struct GC_stack) + stack->used;
+      skip = stack->reserved - stack->used;
+    }
+    size = headerBytes + objectBytes;
+    assert (forwardState.back + size + skip <= forwardState.toLimit);
+    /* Copy the object. */
+    copy (p - headerBytes, forwardState.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 numObjptrs == 1) {
+      GC_weak w;
+      
+      w = (GC_weak)(forwardState.back + GC_NORMAL_HEADER_SIZE);
+      if (DEBUG_WEAK)
+        fprintf (stderr, "forwarding weak "FMTPTR" ",
+                 (uintptr_t)w);
+      if (isObjptr (w->objptr)
+          and (not s->amInMinorGC
+               or isInNursery (s, w->objptr))) {
+        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. */
+    *(GC_header*)(p - GC_HEADER_SIZE) = GC_FORWARDED;
+    *(objptr*)p = pointerToObjptr(forwardState.back + headerBytes, forwardState.toBase);
+    /* Update the back of the queue. */
+    forwardState.back += size + skip;
+    assert (isAligned ((uintptr_t)forwardState.back + GC_NORMAL_HEADER_SIZE, 
+                       s->alignment));
+  }
+  *opp = *(objptr*)p;
+  // assert (isInToSpace (s, *opp));
 }
 
-static void updateWeaks (GC_state s) {
-        GC_weak w;
+static inline void updateWeaks (GC_state s) {
+  pointer p;
+  GC_weak w;
 
-        for (w = s->weaks; w != NULL; w = w->link) {
-                assert ((pointer)BOGUS_POINTER != w->object);
+  for (w = s->weaks; w != NULL; w = w->link) {
+    assert (BOGUS_OBJPTR != w->objptr);
 
-                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;
+    if (DEBUG_WEAK)
+      fprintf (stderr, "updateWeaks  w = "FMTPTR"  ", (uintptr_t)w);
+    p = objptrToPointer (w->objptr, forwardState.fromBase);
+    if (GC_FORWARDED == getHeader (p)) {
+      if (DEBUG_WEAK)
+        fprintf (stderr, "forwarded from "FMTOBJPTR" to "FMTOBJPTR"\n",
+                 w->objptr,
+                 *(objptr*)p);
+      w->objptr = *(objptr*)p;
+    } else {
+      if (DEBUG_WEAK)
+        fprintf (stderr, "cleared\n");
+      *(getHeaderp(p)) = WEAK_GONE_HEADER;
+      w->objptr = BOGUS_OBJPTR;
+    }
+  }
+  s->weaks = NULL;
 }
 
-static void swapSemis (GC_state s) {
+static inline void swapSemis (GC_state s) {
   struct GC_heap tempHeap;
   
   tempHeap = s->secondaryHeap;
   s->secondaryHeap = s->heap;
   s->heap = tempHeap;
-  setCardMapForMutator (s);
+  // setCardMapForMutator (s);
 }
 
-static inline bool detailedGCTime (GC_state s) {
-        return s->summary;
-}
+/* static inline bool detailedGCTime (GC_state s) { */
+/*         return s->summary; */
+/* } */
 
-static void cheneyCopy (GC_state s) {
-        struct rusage ru_start;
-        pointer toStart;
+/* 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->secondaryHeap.start;
-        s->toLimit = s->secondaryHeap.start + s->secondaryHeap.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");
-}
+/*         assert (s->heap2.size >= s->oldGenSize); */
+/*         if (detailedGCTime (s)) */
+/*                 startTiming (&ru_start); */
+/*         s->numCopyingGCs++; */
+/*         s->toSpace = s->secondaryHeap.start; */
+/*         s->toLimit = s->secondaryHeap.start + s->secondaryHeap.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"); */
+/* } */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-09 02:56:17 UTC (rev 4080)
@@ -6,18 +6,20 @@
  * See the file MLton-LICENSE for details.
  */
 
-typedef void (*GC_pointerFun) (GC_state s, objptr *pp);
+typedef void (*GC_foreachObjptrFun) (GC_state s, objptr *opp);
 
-static inline void maybeCall (GC_pointerFun f, GC_state s, objptr *pp) {
-  if (isObjptr (*pp))
-    f (s, pp);
+static inline void maybeCall (GC_foreachObjptrFun f, 
+                              GC_state s, objptr *opp) {
+  if (isObjptr (*opp))
+    f (s, opp);
 }
 
 /* foreachGlobalObjptr (s, f)
  * 
  * Apply f to each global object pointer into the heap. 
  */
-static inline void foreachGlobalObjptr (GC_state s, GC_pointerFun f) {
+static inline void foreachGlobalObjptr (GC_state s, 
+                                        GC_foreachObjptrFun f) {
   for (unsigned int i = 0; i < s->globalsSize; ++i) {
     if (DEBUG_DETAILED)
       fprintf (stderr, "foreachGlobal %u\n", i);
@@ -42,7 +44,7 @@
 static inline pointer foreachObjptrInObject (GC_state s, 
                                              pointer p,
                                              bool skipWeaks,
-                                             GC_pointerFun f) {
+                                             GC_foreachObjptrFun f) {
   bool hasIdentity;
   GC_header header;
   uint16_t numNonObjptrs;
@@ -183,7 +185,7 @@
                                             pointer front, 
                                             pointer *back,
                                             bool skipWeaks,
-                                            GC_pointerFun f) {
+                                            GC_foreachObjptrFun f) {
   pointer b;
 
   assert (isAlignedFrontier (s, front));

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-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c	2005-09-09 02:56:17 UTC (rev 4080)
@@ -1 +1,5 @@
 #include "gc.h"
+
+static inline size_t maxZ (size_t x, size_t y) {
+  return ((x < y) ? x : y);
+}

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-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-09-09 02:56:17 UTC (rev 4080)
@@ -1,6 +1,8 @@
 
 typedef struct GC_state {
   size_t alignment; /* */
+  bool amInGC;
+  bool amInMinorGC;
   objptr callFromCHandler; /* Handler for exported C calls (in heap). */
   objptr currentThread; /* Currently executing thread (in heap). */
   GC_frameLayout *frameLayouts; /* Array of frame layouts. */
@@ -8,6 +10,7 @@
   objptr *globals;
   uint32_t globalsSize;
   struct GC_heap heap;
+  uint32_t maxFrameSize;
   GC_objectType *objectTypes; /* Array of object types. */
   uint32_t objectTypesSize; /* Cardinality of objectTypes array. */
   uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
@@ -16,6 +19,9 @@
                        */
   struct GC_heap secondaryHeap; /* Used for major copying collection. */
   objptr signalHandler; /* Handler for signals (in heap). */
+  pointer stackBottom; /* Bottom of stack in current thread. */
+  pointer stackTop; /* Top of stack in current thread. */
   /*Bool*/bool summary; /* Print a summary of gc info when program exits. */
+  float threadShrinkRatio;
   GC_weak weaks; /* Linked list of (live) weak pointers */
 } *GC_state;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h	2005-09-09 02:56:17 UTC (rev 4080)
@@ -217,7 +217,7 @@
 #define FMTOBJPTR "0x%016"PRIxOBJPTR
 
 #if GC_MODEL_NONPTR
-#define BOGUS_OBJPTR 0x1
+#define BOGUS_OBJPTR (objptr)0x1
 #else
 #error gc model does not admit bogus object pointer
 #endif

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2005-09-09 02:56:17 UTC (rev 4080)
@@ -50,7 +50,7 @@
   return (GC_header*)(p - GC_HEADER_SIZE);
 }
 
-/* GC_getHeader (p) 
+/* getHeader (p) 
  *
  * Returns the header for the object pointed to by p. 
  */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-09-09 02:56:17 UTC (rev 4080)
@@ -11,3 +11,22 @@
   uintptr_t mask = ~((~((uintptr_t)0)) << GC_MODEL_MINALIGN_SHIFT);
   return (0 == ((uintptr_t)p & mask));
 }
+
+static inline void copy (pointer src, pointer dst, size_t size) {
+  unsigned int *to, *from, *limit;
+
+  if (DEBUG_DETAILED)
+    fprintf (stderr, "copy ("FMTPTR", "FMTPTR", %zu)\n",
+             (uintptr_t)src, (uintptr_t)dst, size);
+  assert (isAligned ((uintptr_t)src, sizeof(unsigned int)));
+  assert (isAligned ((uintptr_t)dst, sizeof(unsigned int)));
+  assert (isAligned (size, sizeof(unsigned int)));
+  assert (dst <= src or src + size <= dst);
+  if (src == dst)
+    return;
+  from = (unsigned int*)src;
+  to = (unsigned int*)dst;
+  limit = (unsigned int*)(src + size);
+  until (from == limit)
+    *to++ = *from++;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h	2005-09-09 02:56:17 UTC (rev 4080)
@@ -9,4 +9,4 @@
 typedef unsigned char* pointer;
 #define POINTER_SIZE sizeof(pointer);
 #define FMTPTR "0x%016"PRIxPTR
-#define BOGUS_POINTER 0x1
+#define BOGUS_POINTER (pointer)0x1

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-09-09 02:56:17 UTC (rev 4080)
@@ -6,6 +6,31 @@
  * See the file MLton-LICENSE for details.
  */
 
+static inline bool stackIsEmpty (GC_stack stack) {
+        return 0 == stack->used;
+}
+
+/* stackSlop returns the amount of "slop" space needed between the top
+ * of the stack and the end of the stack space.
+ */
+static inline size_t stackSlop (GC_state s) {
+  return (size_t)(2 * s->maxFrameSize);
+}
+
+static inline size_t initialStackSize (GC_state s) {
+  return stackSlop (s);
+}
+
+static inline size_t stackBytes (GC_state s, size_t size) {
+  size_t res;
+  
+  res = align (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + size,
+               s->alignment);
+  if (DEBUG_STACKS)
+    fprintf (stderr, "%zu = stackBytes (%zu)\n", res, size);
+  return res;
+}
+
 static inline pointer stackBottom (GC_state s, GC_stack stack) {
         pointer res;
 
@@ -18,3 +43,42 @@
 static inline pointer stackTop (GC_state s, GC_stack stack) {
         return stackBottom (s, stack) + stack->used;
 }
+
+static inline uint32_t topFrameIndex (GC_state s, GC_stack stack) {
+  uint32_t res;
+
+  res = getFrameIndex (s, 
+                       *(GC_returnAddress*)
+                       (stackTop (s, stack) - GC_RETURNADDRESS_SIZE));
+  if (DEBUG_PROFILE)
+    fprintf (stderr, "topFrameIndex = %"PRIu32"\n", res);
+  return res;
+}
+
+static inline GC_frameLayout * topFrameLayout (GC_state s, GC_stack stack) {
+  GC_frameLayout *layout;
+
+  layout = getFrameLayout (s, topFrameIndex (s, stack));
+  return layout;
+}
+
+static inline uint16_t topFrameSize (GC_state s, GC_stack stack) {
+  GC_frameLayout *layout;
+  
+  assert (not (stackIsEmpty (stack)));
+  layout = topFrameLayout (s, stack);
+  return layout->numBytes;
+}
+
+static inline size_t stackReserved (GC_state s, size_t r) {
+  size_t res;
+
+  res = pad (s, r, GC_STACK_HEADER_SIZE + sizeof (struct GC_stack));
+  if (DEBUG_STACKS)
+    fprintf (stderr, "%zu = stackReserved (%zu)\n", res, r);
+  return res;
+}
+
+static inline size_t stackNeedsReserved (GC_state s, GC_stack stack) {
+  return stack->used + stackSlop (s) - topFrameSize(s, stack);
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h	2005-09-09 02:56:17 UTC (rev 4080)
@@ -46,4 +46,5 @@
    * reserved bytes hold space for the stack.
    */
 } *GC_stack;
+#define GC_STACK_HEADER_SIZE GC_HEADER_SIZE
 #define GC_STACK_SIZE sizeof(struct GC_stack);

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c (from rev 4078, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c	2005-09-09 02:56:17 UTC (rev 4080)
@@ -0,0 +1,17 @@
+/* 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 GC_thread currentThread (GC_state s) {
+  pointer p = objptrToPointer(s->currentThread, s->heap.start);
+  return (GC_thread)p;
+}
+
+static inline objptr currentThreadStack (GC_state s) {
+  GC_thread ct = currentThread (s);
+  return ct->stack;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h	2005-09-09 02:56:17 UTC (rev 4080)
@@ -36,6 +36,7 @@
 #define FALSE   (not TRUE)
 #endif
 #define unless(p)       if (not (p))
+#define until(p)        while (not (p))
 
 /* issue error message and exit */
 extern void die (char *fmt, ...)

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h	2005-09-09 01:04:14 UTC (rev 4079)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h	2005-09-09 02:56:17 UTC (rev 4080)
@@ -29,5 +29,5 @@
 typedef struct GC_weak {
   uint32_t unused;
   struct GC_weak *link;
-  objptr object;
+  objptr objptr;
 } *GC_weak;

Through foreachObjptrInObject
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U   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/array.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.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
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-09-09 01:04:14 UTC (rev 4079)
@@ -61,6 +61,8 @@
 	model.c								\
 	object.c							\
 	array.c								\
+	frame.c								\
+	stack.c								\
 	foreach.c							\
 	assumptions.c							\
 	gc_suffix.c
@@ -73,8 +75,8 @@
 	model.h								\
 	object.h							\
 	array.h								\
+	frame.h								\
 	stack.h								\
-	frame.h								\
 	thread.h							\
 	weak.h								\
 	heap.h								\

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO	2005-09-09 01:04:14 UTC (rev 4079)
@@ -11,3 +11,7 @@
         the word after the header to get GC_weak to overlay properly.
 * what type should be used for the size field in GC_heap?  I'm using
         size_t currently, since that is the type needed by malloc.
+* I don't believe the comment concerning exnStack and the native
+        codegen in thread.h is still true; it used to be the case when
+        GC_switchToThread was implemented in codegens.  Now it should
+        be implemented in Backend.

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-09-09 01:04:14 UTC (rev 4079)
@@ -6,7 +6,7 @@
  * See the file MLton-LICENSE for details.
  */
 
-static inline uintptr_t align (uintptr_t a, uintptr_t b) {
+static inline size_t align (size_t a, size_t b) {
   assert (a >= 0);
   assert (b >= 1);
   a += b - 1;
@@ -28,12 +28,12 @@
 }
 */
 
-static bool isAligned (uintptr_t a, size_t b) {
+static inline bool isAligned (uintptr_t a, size_t b) {
   return 0 == a % b;
 }
 
 #if ASSERT
-static bool isAlignedFrontier (GC_state s, pointer p) {
+static inline bool isAlignedFrontier (GC_state s, pointer p) {
   return isAligned ((uintptr_t)p + GC_NORMAL_HEADER_SIZE, s->alignment);
 }
 
@@ -49,15 +49,15 @@
   return align (bytes + extra, s->alignment) - extra;
 }
 
-/*
 static inline pointer alignFrontier (GC_state s, pointer p) {
-  return (pointer) pad (s, (uintptr_t)p, GC_NORMAL_HEADER_SIZE);
+  return (pointer) pad (s, (size_t)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;
   

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c	2005-09-09 01:04:14 UTC (rev 4079)
@@ -7,17 +7,17 @@
  */
 
 #if ASSERT
-static pointer arrayPointer (GC_state s, 
-                             pointer a, 
-                             uint32_t arrayIndex, 
-                             uint32_t pointerIndex) {
+static inline pointer arrayIndexAtPointer (GC_state s, 
+                                           pointer a, 
+                                           uint32_t arrayIndex, 
+                                           uint32_t pointerIndex) {
   bool hasIdentity;
   GC_header header;
   uint16_t numNonObjptrs;
   uint16_t numObjptrs;
   GC_objectTypeTag tag;
   
-  header = GC_getHeader (a);
+  header = getHeader (a);
   SPLIT_HEADER();
   assert (tag == ARRAY_TAG);
 
@@ -41,7 +41,7 @@
   GC_arrayLength numElements;
   size_t result;
         
-  numElements = GC_arrayNumElements (p);
+  numElements = arrayNumElements (p);
   bytesPerElement = 
     numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG) 
     + (numObjptrs * OBJPTR_SIZE);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h	2005-09-09 01:04:14 UTC (rev 4079)
@@ -19,16 +19,14 @@
  * individual layout as normal objects, omitting the header word.
  */
 typedef uint32_t GC_arrayLength;
-enum {
-  GC_ARRAY_LENGTH_SIZE =  sizeof(GC_arrayLength),
-  GC_ARRAY_COUNTER_SIZE = GC_ARRAY_LENGTH_SIZE,
-  GC_ARRAY_HEADER_SIZE =  GC_ARRAY_COUNTER_SIZE + GC_ARRAY_LENGTH_SIZE + GC_HEADER_SIZE,
-};
+#define GC_ARRAY_LENGTH_SIZE sizeof(GC_arrayLength)
+#define GC_ARRAY_COUNTER_SIZE GC_ARRAY_LENGTH_SIZE
+#define GC_ARRAY_HEADER_SIZE (GC_ARRAY_COUNTER_SIZE + GC_ARRAY_LENGTH_SIZE + GC_HEADER_SIZE)
 
-static inline GC_arrayLength* GC_arrayNumElementsp (pointer a) {
+static inline GC_arrayLength* arrayNumElementsp (pointer a) {
   return (GC_arrayLength*)(a - GC_HEADER_SIZE - GC_ARRAY_LENGTH_SIZE);
 }
 
-static inline GC_arrayLength GC_arrayNumElements (pointer a) {
-  return *(GC_arrayNumElementsp (a));
+static inline GC_arrayLength arrayNumElements (pointer a) {
+  return *(arrayNumElementsp (a));
 }

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c	2005-09-09 01:04:14 UTC (rev 4079)
@@ -9,16 +9,16 @@
 typedef void (*GC_pointerFun) (GC_state s, objptr *pp);
 
 static inline void maybeCall (GC_pointerFun f, GC_state s, objptr *pp) {
-  if (GC_isObjptr (*pp))
+  if (isObjptr (*pp))
     f (s, pp);
 }
 
-/* foreachGlobal (s, f)
+/* foreachGlobalObjptr (s, f)
  * 
  * Apply f to each global object pointer into the heap. 
  */
-static inline void foreachGlobal (GC_state s, GC_pointerFun f) {
-  for (int i = 0; i < s->globalsSize; ++i) {
+static inline void foreachGlobalObjptr (GC_state s, GC_pointerFun f) {
+  for (unsigned int i = 0; i < s->globalsSize; ++i) {
     if (DEBUG_DETAILED)
       fprintf (stderr, "foreachGlobal %u\n", i);
     maybeCall (f, s, &s->globals [i]);
@@ -32,33 +32,33 @@
 }
 
 
-/* foreachPointerInObject (s, p, skipWeaks, f) 
+/* foreachObjptrInObject (s, p, skipWeaks, f) 
  * 
  * Applies f to each object pointer in the object pointed to by p.
  * Returns pointer to the end of object, i.e. just past object.
  *
  * If skipWeaks, then the object pointer in weak objects is skipped.
  */
-static inline pointer foreachPointerInObject (GC_state s, 
-                                              pointer p,
-                                              bool skipWeaks,
-                                              GC_pointerFun f) {
+static inline pointer foreachObjptrInObject (GC_state s, 
+                                             pointer p,
+                                             bool skipWeaks,
+                                             GC_pointerFun f) {
   bool hasIdentity;
   GC_header header;
   uint16_t numNonObjptrs;
   uint16_t numObjptrs;
   GC_objectTypeTag tag;
 
-  header = GC_getHeader (p);
+  header = getHeader (p);
   SPLIT_HEADER();
   if (DEBUG_DETAILED)
     fprintf (stderr, 
-             "foreachPointerInObject ("FMTPTR")"
+             "foreachObjptrInObject ("FMTPTR")"
              "  header = "FMTHDR
              "  tag = %s"
              "  numNonObjptrs = %d"
              "  numObjptrs = %d\n", 
-             (intptr_t)p, header, tagToString (tag), 
+             (uintptr_t)p, header, tagToString (tag), 
              numNonObjptrs, numObjptrs);
   if (NORMAL_TAG == tag) {
     p += numNonObjptrsToBytes(numNonObjptrs, NORMAL_TAG);
@@ -67,8 +67,8 @@
     for ( ; p < max; p += OBJPTR_SIZE) {
       if (DEBUG_DETAILED)
         fprintf (stderr, 
-                 "p = "FMTPTR"  *p = "FMTOBJPTR"\n",
-                 (intptr_t)p, *(objptr*)p);
+                 "  p = "FMTPTR"  *p = "FMTOBJPTR"\n",
+                 (uintptr_t)p, *(objptr*)p);
       maybeCall (f, s, (objptr*)p);
     }
   } else if (WEAK_TAG == tag) {
@@ -83,7 +83,7 @@
     pointer max;
     GC_arrayLength numElements;
     
-    numElements = GC_arrayNumElements (p);
+    numElements = arrayNumElements (p);
     bytesPerElement = 
       numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG) 
       + (numObjptrs * OBJPTR_SIZE);
@@ -101,7 +101,7 @@
       max = p + dataBytes;
       if (0 == numNonObjptrs)
         /* Array with only pointers. */
-        for (; p < max; p += OBJPTR_SIZE)
+        for ( ; p < max; p += OBJPTR_SIZE)
           maybeCall (f, s, (objptr*)p);
       else {
         /* Array with a mix of pointers and non-pointers. */
@@ -128,70 +128,69 @@
     }
     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; */
+    GC_stack stack; 
+    pointer top, bottom; 
+    unsigned int i;
+    GC_returnAddress returnAddress; 
+    GC_frameLayout *frameLayout;
+    GC_frameOffsets frameOffsets;
+
+    assert (STACK_TAG == tag);
+    stack = (GC_stack)p;
+    bottom = stackBottom (s, stack); 
+    top = stackTop (s, stack);
+    if (DEBUG) {
+      fprintf (stderr, "  bottom = "FMTPTR"  top = "FMTPTR"\n",
+               (uintptr_t)bottom, (uintptr_t)top);
+    }
+    assert (stack->used <= stack->reserved);
+    while (top > bottom) {
+      /* Invariant: top points just past a "return address". */
+      returnAddress = *(GC_returnAddress*) (top - GC_RETURNADDRESS_SIZE);
+      if (DEBUG) {
+        fprintf (stderr, "  top = "FMTPTR"  return address = "FMTPTR"\n",
+                 (uintptr_t)top, returnAddress);
+      }
+      frameLayout = getFrameLayout (s, returnAddress);
+      frameOffsets = frameLayout->offsets;
+      top -= frameLayout->numBytes;
+      for (i = 0 ; i < frameOffsets[0] ; ++i) {
+        if (DEBUG)
+          fprintf(stderr, "  offset %"PRIx16"  address "FMTOBJPTR"\n",
+                  frameOffsets[i + 1], *(objptr*)(top + frameOffsets[i + 1]));
+        maybeCall(f, s, (objptr*)(top + frameOffsets[i + 1]));
+      }
+    }
+    assert(top == bottom);
+    p += sizeof (struct GC_stack) + stack->reserved;
   }
   return p;
 }
 
-/* foreachPointerInRange (s, front, back, skipWeaks, f)
+/* foreachObjptrInRange (s, front, back, skipWeaks, 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
+ * forward).  foreachObjptrInRange returns a pointer to the end of
  * the last object it visits.
  *
  * If skipWeaks, 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) {
+static inline pointer foreachObjptrInRange (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 = "FMTPTR"  *back = "FMTPTR"\n",
-             (intptr_t)front, (intptr_t)(*back));
+             "foreachObjptrInRange  front = "FMTPTR"  *back = "FMTPTR"\n",
+             (uintptr_t)front, (uintptr_t)(*back));
   b = *back;
   assert (front <= b);
   while (front < b) {
@@ -199,9 +198,9 @@
       assert (isAligned ((uintptr_t)front, GC_MODEL_MINALIGN));
       if (DEBUG_DETAILED)
         fprintf (stderr, 
-                 "front = "FMTPTR"  *back = "FMTPTR"\n",
-                 (intptr_t)front, (intptr_t)(*back));
-      front = foreachPointerInObject (s, toData (s, front), skipWeaks, f);
+                 "  front = "FMTPTR"  *back = "FMTPTR"\n",
+                 (uintptr_t)front, (uintptr_t)(*back));
+      front = foreachObjptrInObject (s, toData (s, front), skipWeaks, f);
     }
     b = *back;
   }

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c (from rev 4078, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c	2005-09-09 01:04:14 UTC (rev 4079)
@@ -0,0 +1,34 @@
+/* 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 uint32_t getFrameIndex (GC_state s, GC_returnAddress ra) {
+  uint32_t res;
+
+  res = s->returnAddressToFrameIndex (ra);
+  if (DEBUG_DETAILED)
+    fprintf (stderr, "%"PRIu32" = getFrameIndex ("FMTRA")\n",
+             res, ra);
+  return res;
+}
+
+static inline GC_frameLayout * getFrameLayout (GC_state s, GC_returnAddress ra) {
+  GC_frameLayout *layout;
+  uint32_t index;
+
+  index = getFrameIndex (s, ra);
+  if (DEBUG_DETAILED)
+    fprintf (stderr, 
+             "returnAddress = "FMTRA
+             "  index = %"PRIx32
+             "  frameLayoutsSize = %"PRIu16"\n",
+             ra, index, s->frameLayoutsSize);
+  assert (0 <= index and index < s->frameLayoutsSize);
+  layout = &(s->frameLayouts[index]);
+  assert (layout->numBytes > 0);
+  return layout;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h	2005-09-09 01:04:14 UTC (rev 4079)
@@ -25,15 +25,14 @@
  * array) whose elements record byte offsets from the bottom of the
  * frame at which live heap pointers are located.
  */
-typedef uint16_t *GC_offsets;
+typedef uint16_t *GC_frameOffsets;
 
 typedef struct GC_frameLayout {
-  /* Identifies whether or not the frame is for a C call.  */
   bool isC;
-  /* Number of bytes in frame, including space for return address. */
   uint16_t numBytes;
-  /* Offsets from stackTop pointing at bottom of frame at which
-   * pointers are located.
-   */
-  GC_offsets offsets;
+  GC_frameOffsets offsets;
 } GC_frameLayout;
+
+typedef uintptr_t GC_returnAddress;
+#define GC_RETURNADDRESS_SIZE sizeof(GC_returnAddress)
+#define FMTRA "0x%016"PRIxPTR

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-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h	2005-09-09 01:04:14 UTC (rev 4079)
@@ -3,11 +3,14 @@
   size_t alignment; /* */
   objptr callFromCHandler; /* Handler for exported C calls (in heap). */
   objptr currentThread; /* Currently executing thread (in heap). */
+  GC_frameLayout *frameLayouts; /* Array of frame layouts. */
+  uint32_t frameLayoutsSize; /* Cardinality of frameLayouts array. */
   objptr *globals;
   uint32_t globalsSize;
   struct GC_heap heap;
   GC_objectType *objectTypes; /* Array of object types. */
   uint32_t objectTypesSize; /* Cardinality of objectTypes array. */
+  uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
   objptr savedThread; /* Result of GC_copyCurrentThread.
                        * Thread interrupted by arrival of signal.
                        */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h	2005-09-09 01:04:14 UTC (rev 4079)
@@ -18,6 +18,6 @@
 */
 
 typedef struct GC_heap {
-  size_t size;
-  pointer start;          /* start of memory area */
+  size_t numBytes; /* size of heap */
+  pointer start; /* start of heap */
 } *GC_heap;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c	2005-09-09 01:04:14 UTC (rev 4079)
@@ -21,7 +21,7 @@
   P_ = ((O_ << S_) + B_);
   P = (pointer)P_;
   if (DEBUG_DETAILED) 
-    fprintf (stderr, "objptrToPointer ("FMTOBJPTR") = "FMTPTR"\n", O, (intptr_t)P);
+    fprintf (stderr, "objptrToPointer ("FMTOBJPTR") = "FMTPTR"\n", O, (uintptr_t)P);
   
   return P;
 }
@@ -42,13 +42,13 @@
   O_ = ((P_ - B_) >> S_);
   O = (objptr)O_;
   if (DEBUG_DETAILED) 
-    fprintf (stderr, "pointerToObjptr ("FMTPTR") = "FMTOBJPTR"\n", (intptr_t)P, O);
+    fprintf (stderr, "pointerToObjptr ("FMTPTR") = "FMTOBJPTR"\n", (uintptr_t)P, O);
 
   return O;
 }
 
-/* GC_isObjptr returns true if p looks like an object pointer. */
-static inline bool GC_isObjptr (objptr p) {
+/* isObjptr returns true if p looks like an object pointer. */
+static inline bool isObjptr (objptr p) {
   if GC_MODEL_NONPTR {
     unsigned int shift = GC_MODEL_MINALIGN_SHIFT - GC_MODEL_SHIFT;
     objptr mask = ~((~((objptr)0)) << shift);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h	2005-09-09 01:04:14 UTC (rev 4079)
@@ -27,10 +27,10 @@
  *      31   : mark bit, used by mark compact GC (initially 0)
  */
 typedef uint32_t GC_header;
+#define GC_HEADER_SIZE sizeof(GC_header)
 #define PRIxHDR PRIx32
 #define FMTHDR "0x%08"PRIxHDR
 enum {
-  GC_HEADER_SIZE =   sizeof(GC_header),
   TYPE_INDEX_BITS =  19,
   TYPE_INDEX_MASK =  0x000FFFFE,
   TYPE_INDEX_SHIFT = 1,
@@ -42,11 +42,11 @@
   MARK_SHIFT =       31
 };
 
-/* GC_getHeaderp (p)
+/* getHeaderp (p)
  *
  * Returns a pointer to the header for the object pointed to by p.
  */
-static inline GC_header* GC_getHeaderp (pointer p) {
+static inline GC_header* getHeaderp (pointer p) {
   return (GC_header*)(p - GC_HEADER_SIZE);
 }
 
@@ -54,8 +54,8 @@
  *
  * Returns the header for the object pointed to by p. 
  */
-static inline GC_header GC_getHeader (pointer p) {
-  return *(GC_getHeaderp(p));
+static inline GC_header getHeader (pointer p) {
+  return *(getHeaderp(p));
 }
 
 /*
@@ -72,9 +72,7 @@
  * Likewise, a primitive value may span multiple native words (e.g.,
  * Word64.word).
 */
-enum {
-  GC_NORMAL_HEADER_SIZE = GC_HEADER_SIZE,
-};
+#define GC_NORMAL_HEADER_SIZE GC_HEADER_SIZE
 
 /* Array objects are described in "array.h" */
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c	2005-09-09 01:04:14 UTC (rev 4079)
@@ -6,8 +6,8 @@
  * See the file MLton-LICENSE for details.
  */
 
-/* GC_isPointer returns true if p looks like a pointer. */
-static inline bool GC_isPointer (pointer p) {
+/* isPointer returns true if p looks like a pointer. */
+static inline 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-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h	2005-09-09 01:04:14 UTC (rev 4079)
@@ -7,5 +7,6 @@
  */
 
 typedef unsigned char* pointer;
+#define POINTER_SIZE sizeof(pointer);
 #define FMTPTR "0x%016"PRIxPTR
 #define BOGUS_POINTER 0x1

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c (from rev 4078, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c	2005-09-09 01:04:14 UTC (rev 4079)
@@ -0,0 +1,20 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+static inline pointer stackBottom (GC_state s, GC_stack stack) {
+        pointer res;
+
+        res = ((pointer)stack) + sizeof (struct GC_stack);
+        assert (isAligned ((uintptr_t)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;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h	2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h	2005-09-09 01:04:14 UTC (rev 4079)
@@ -46,3 +46,4 @@
    * reserved bytes hold space for the stack.
    */
 } *GC_stack;
+#define GC_STACK_SIZE sizeof(struct GC_stack);

Fixed bug in Real.signBit, which had assumed that the underlying C
signbit returned 0 or 1, when in fact any nonzero value is allowed to
indicate the signbit is set.


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

U   mlton/trunk/basis-library/misc/primitive.sml
U   mlton/trunk/basis-library/real/real.fun
U   mlton/trunk/basis-library/real/real.sig
U   mlton/trunk/doc/changelog

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

Modified: mlton/trunk/basis-library/misc/primitive.sml
===================================================================
--- mlton/trunk/basis-library/misc/primitive.sml	2005-09-06 23:31:48 UTC (rev 4077)
+++ mlton/trunk/basis-library/misc/primitive.sml	2005-09-07 00:47:05 UTC (rev 4078)
@@ -1350,7 +1350,7 @@
             val modf = _import "Real64_modf": real * real ref -> real;
             val nextAfter = _import "Real64_nextAfter": real * real -> real;
             val round = _prim "Real64_round": real -> real;
-            val signBit = _import "Real64_signBit": real -> bool;
+            val signBit = _import "Real64_signBit": real -> int;
             val strto = _import "Real64_strto": NullString.t -> real;
             val toInt = _prim "Real64_toWordS32": real -> int;
             val ~ = _prim "Real64_neg": real -> real;
@@ -1423,7 +1423,7 @@
             val minNormalPos = #1 _symbol "Real32_minNormalPos": real GetSet.t; ()
             val minPos = #1 _symbol "Real32_minPos": real GetSet.t; ()
             val modf = _import "Real32_modf": real * real ref -> real;
-            val signBit = _import "Real32_signBit": real -> bool;
+            val signBit = _import "Real32_signBit": real -> int;
             val strto = _import "Real32_strto": NullString.t -> real;
             val toInt = _prim "Real32_toWordS32": real -> int;
             val ~ = _prim "Real32_neg": real -> real;

Modified: mlton/trunk/basis-library/real/real.fun
===================================================================
--- mlton/trunk/basis-library/real/real.fun	2005-09-06 23:31:48 UTC (rev 4077)
+++ mlton/trunk/basis-library/real/real.fun	2005-09-07 00:47:05 UTC (rev 4078)
@@ -48,7 +48,7 @@
          val minPos = minPos
          val precision = precision
          val radix = radix
-         val signBit = signBit
+         val signBit = fn r => signBit r <> 0
          val toLarge = toLarge
       end
 

Modified: mlton/trunk/basis-library/real/real.sig
===================================================================
--- mlton/trunk/basis-library/real/real.sig	2005-09-06 23:31:48 UTC (rev 4077)
+++ mlton/trunk/basis-library/real/real.sig	2005-09-07 00:47:05 UTC (rev 4078)
@@ -41,7 +41,7 @@
       val nextAfterUp: real -> real
       val precision: int
       val radix: int
-      val signBit: real -> bool
+      val signBit: real -> int
       val strto: NullString.t -> real
       val toInt: real -> int
       val toLarge: real -> LargeReal.real        

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2005-09-06 23:31:48 UTC (rev 4077)
+++ mlton/trunk/doc/changelog	2005-09-07 00:47:05 UTC (rev 4078)
@@ -1,5 +1,10 @@
 Here are the changes since version 20041109.
 
+* 2005-09-06
+  - Fixed bug in Real.signBit, which had assumed that the underlying
+    C signbit returned 0 or 1, when in fact any nonzero value is
+    allowed to indicate the signbit is set.
+
 * 2005-09-05
   - Added -mlb-path-map switch.
 

grab news img
----------------------------------------------------------------------

U   mlton/trunk/bin/grab-wiki

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

Modified: mlton/trunk/bin/grab-wiki
===================================================================
--- mlton/trunk/bin/grab-wiki	2005-09-06 23:25:52 UTC (rev 4076)
+++ mlton/trunk/bin/grab-wiki	2005-09-06 23:31:48 UTC (rev 4077)
@@ -52,7 +52,7 @@
 done
 
 echo "Getting images:"
-for f in bottom email ftp top www; do
+for f in bottom email ftp news top www; do
 	wget -c $base/wiki/mlton/img/moin-$f.png
 done
 #fi

Debian packaging fix.

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

U   mlton/trunk/Makefile

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

Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile	2005-09-06 22:08:30 UTC (rev 4075)
+++ mlton/trunk/Makefile	2005-09-06 23:25:52 UTC (rev 4076)
@@ -431,7 +431,7 @@
 	$(CP) $(SRC)/debian/copyright $(SRC)/debian/README.Debian $(TDOC)/
 	$(CP) $(SRC)/debian/changelog $(TDOC)/changelog.Debian
 	mkdir -p $(TDOCBASE)
-	for f in mllex mlyacc; do \
+	for f in mllex mlton mlyacc; do \
 		$(CP) $(SRC)/debian/$$f.doc-base $(TDOCBASE)/$$f; \
 	done
 	cd $(TDOC)/ && $(GZIP) changelog changelog.Debian

New Debian package.

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

U   mlton/trunk/package/debian/changelog

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

Modified: mlton/trunk/package/debian/changelog
===================================================================
--- mlton/trunk/package/debian/changelog	2005-09-06 22:00:52 UTC (rev 4074)
+++ mlton/trunk/package/debian/changelog	2005-09-06 22:08:30 UTC (rev 4075)
@@ -1,3 +1,9 @@
+mlton (20050906-1) unstable; urgency=low
+
+  * Replaces -mv8 with -mcpu=v8 for Sparc.
+
+ -- Stephen Weeks <sw...@sw...>  Tue, 06 Sep 2005 14:57:46 -0700
+
 mlton (20050901-1) unstable; urgency=low
 
   * remaking package, linking normally with libgmp.  Thus, the package

Added support for platform-specific regression outputs, and used them
to quell some of the noise in Cygwin regressions.

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

U   mlton/trunk/bin/regression
A   mlton/trunk/regression/filesys.x86-cygwin.ok
A   mlton/trunk/regression/unixpath.x86-cygwin.ok

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

Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression	2005-09-06 21:14:53 UTC (rev 4073)
+++ mlton/trunk/bin/regression	2005-09-06 22:00:52 UTC (rev 4074)
@@ -54,6 +54,7 @@
 dir=`dirname $0`
 src=`cd $dir/.. && pwd`
 bin="$src/build/bin"
+lib="$src/build/lib"
 mlton="$bin/mlton"
 flags="-type-check true $flags"
 if [ $cross = 'yes' ]; then
@@ -68,6 +69,8 @@
 tmp=/tmp/z.regression.$$
 PATH=$bin:$src/bin/.:$PATH
 
+eval `$lib/platform`
+
 compFail () {
         echo "compilation of $f failed with $flags"
 }
@@ -178,14 +181,15 @@
                         esac
                         ( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1 
                         if [ -r $f.ok ]; then
+				compare="$f.$HOST_ARCH-$HOST_OS.ok"
+				if [ ! -r $compare ]; then
+					compare="$f.ok"
+				fi
                                 case $crossTarget in
                                 *mingw)
                                         compare="$f.sed.ok"
                                         sed 's/$/\r/' <"$f.ok" >"$compare"
                                 ;;
-                                *)
-                                        compare="$f.ok"
-                                ;;
                                 esac
                                 if ! diff $compare $tmp; then
                                         echo "difference with $flags"

Added: mlton/trunk/regression/filesys.x86-cygwin.ok
===================================================================
--- mlton/trunk/regression/filesys.x86-cygwin.ok	2005-09-06 21:14:53 UTC (rev 4073)
+++ mlton/trunk/regression/filesys.x86-cygwin.ok	2005-09-06 22:00:52 UTC (rev 4074)
@@ -0,0 +1,63 @@
+
+File filesys.sml: Testing structure FileSys...
+test1a    	OK
+test1b    	OK
+test2    	OK
+test3a    	OK
+test4a    	OK
+test4b    	OK
+test4c    	OK
+test4d    	OK
+test5    	OK
+test6a    	OK
+test6b    	OK
+test6c    	OK
+test6d    	OK
+test6e    	OK
+test6f    	OK
+test6g    	OK
+test6h    	OK
+test6i    	OK
+test6j    	OK
+test6k    	OK
+test6l    	OK
+test7a    	OK
+test7b    	OK
+test7c    	OK
+test7d    	OK
+test7e    	OK
+test8a    	EXN
+test8b    	EXN
+test8c    	OK
+test8d    	OK
+test8e    	EXN
+test8f    	EXN
+test8g    	OK
+test8h    	OK
+test9a    	OK
+test9b    	OK
+test10a    	OK
+test10b    	OK
+test10c    	OK
+test11a    	OK
+test11b    	OK
+test11c    	OK
+test12a    	OK
+test12b    	OK
+test12c    	OK
+test13a    	OK
+test13b    	OK
+test13c    	OK
+test13d    	OK
+test13e    	OK
+test14    	OK
+test15a    	OK
+test15b    	OK
+test15b1    	OK
+test15b2    	OK
+test15b3    	OK
+test15c    	OK
+test15d    	OK
+test15e    	OK
+test15f    	OK
+test15g    	OK

Added: mlton/trunk/regression/unixpath.x86-cygwin.ok
===================================================================
--- mlton/trunk/regression/unixpath.x86-cygwin.ok	2005-09-06 21:14:53 UTC (rev 4073)
+++ mlton/trunk/regression/unixpath.x86-cygwin.ok	2005-09-06 22:00:52 UTC (rev 4074)
@@ -0,0 +1,61 @@
+
+File unixpath.sml: Testing structure Path...
+test1a    	OK
+test1b    	WRONG
+test1c    	WRONG
+test1d    	OK
+test1e    	WRONG
+test1f    	WRONG
+test1g    	OK
+test1h    	OK
+test1i    	OK
+test1j    	OK
+test1k    	OK
+test1l    	OK
+test1m    	OK
+test1n    	OK
+test2a    	OK
+test2b    	EXN
+test2c    	EXN
+test2d    	OK
+test2e    	EXN
+test2f    	EXN
+test2g    	WRONG
+test2h    	WRONG
+test2i    	WRONG
+test2j    	WRONG
+test2k    	WRONG
+test2l    	WRONG
+test2m    	WRONG
+test2n    	EXN
+test2o    	OK
+test2p    	WRONG
+test3b    	WRONG
+test3c    	WRONG
+test3d    	OK
+test3e    	OK
+test3f    	OK
+test3g    	OK
+test3h    	WRONG
+test4a    	OK
+test4b    	OK
+test5a    	WRONG
+test6a    	WRONG
+test6b    	OK
+test7a    	WRONG
+test7b    	OK
+test7c    	OK
+test8a    	WRONG
+test8b    	OK
+test8c    	OK
+test9a    	WRONG
+test10a    	OK
+test11a    	WRONG
+test12    	WRONG
+test13    	WRONG
+test14    	OK
+test15    	WRONG
+test16    	OK
+test17    	OK
+test18    	WRONG
+test19    	WRONG

Added guide to install-docs target.

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

U   mlton/trunk/Makefile
U   mlton/trunk/doc/README
A   mlton/trunk/package/debian/mlton.doc-base
U   mlton/trunk/package/debian/mlton.postinst

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

Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile	2005-09-06 19:36:07 UTC (rev 4072)
+++ mlton/trunk/Makefile	2005-09-06 21:14:53 UTC (rev 4073)
@@ -403,15 +403,14 @@
 .PHONY: install-docs
 install-docs:
 	mkdir -p $(TDOC)
-	(									\
-		cd $(SRC)/doc &&						\
-		$(CP) changelog examples license README $(TDOC)/		\
+	(								\
+		cd $(SRC)/doc &&					\
+		$(CP) changelog examples guide license README $(TDOC)/	\
 	)
-	(									\
-		cd $(SRC)/util &&						\
-		$(CP) cmcat cm2mlb $(TDOC)/					\
+	(								\
+		cd $(SRC)/util &&					\
+		$(CP) cmcat cm2mlb $(TDOC)/				\
 	)
-	rm -rf $(TDOC)/user-guide
 	for f in callcc command-line hello-world same-fringe signals	\
 			size taut thread1 thread2 thread-switch timeout \
 		; do 							\

Modified: mlton/trunk/doc/README
===================================================================
--- mlton/trunk/doc/README	2005-09-06 19:36:07 UTC (rev 4072)
+++ mlton/trunk/doc/README	2005-09-06 21:14:53 UTC (rev 4073)
@@ -2,8 +2,9 @@
 programming language. MLton has the following features.
 
    + Runs on a variety of platforms.
-     o X86: Linux, Cygwin/Windows, FreeBSD, and NetBSD.
-     o Sparc: Solaris.
+     o PowerPC: Debian, Mac OSX
+     o X86: Linux, Cygwin/Windows, FreeBSD, NetBSD, OpenBSD
+     o Sparc: Debian, Solaris.
    + Generates standalone executables with excellent running times.
    + Supports the full SML 97 language.
    + A complete basis library matching the latest specification.
@@ -34,8 +35,8 @@
         cm2mlb/                 a utility for producing ML Basis programs in SML/NJ
         cmcat/                  a utility for producing whole programs in SML/NJ
         examples/               example SML programs
+	guide/			MLton guide
         license/                license information
         mllex.ps.gz             user guide for mllex lexer generator
         mlyacc.ps.gz            user guide for mlyacc parser generator
-        user-guide/             html user guide
-        user-guide.ps.gz        user guide for MLton
+

Added: mlton/trunk/package/debian/mlton.doc-base
===================================================================
--- mlton/trunk/package/debian/mlton.doc-base	2005-09-06 19:36:07 UTC (rev 4072)
+++ mlton/trunk/package/debian/mlton.doc-base	2005-09-06 21:14:53 UTC (rev 4073)
@@ -0,0 +1,10 @@
+Document: mlton
+Title: MLton Guide
+Author: The MLton Team
+Abstract: This document describes how to use MLton, a whole-program
+ optimizing compiler for the Standard ML Programming language.
+Section: Apps/Programming
+
+Format: HTML
+Index: /usr/share/doc/mlton/user-guide/Home
+Files: /usr/share/doc/mlton/user-guide/*.html

Modified: mlton/trunk/package/debian/mlton.postinst
===================================================================
--- mlton/trunk/package/debian/mlton.postinst	2005-09-06 19:36:07 UTC (rev 4072)
+++ mlton/trunk/package/debian/mlton.postinst	2005-09-06 21:14:53 UTC (rev 4073)
@@ -3,7 +3,7 @@
 set -e
 
 if [ "$1" = configure ] && which install-docs >/dev/null 2>&1; then
-	for f in mllex mlyacc; do
+	for f in mllex mlton mlyacc; do
 		install-docs -i /usr/share/doc-base/$f
 	done
 fi