[MLton-commit] r4117

Matthew Fluet MLton@mlton.org
Fri, 21 Oct 2005 17:34:36 -0700


Some thread functions
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
A   mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h

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

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile	2005-10-22 00:34:28 UTC (rev 4117)
@@ -62,11 +62,11 @@
 	-Wpacked \
 	-Wredundant-decls \
 	-Wnested-externs 
-##	-Wshadow
-##	-Wconversion 
-##	-Wmissing-prototypes
-##	-Wmissing-declarations
-##	-Winline -Wdisabled-optimization
+#	-Wshadow \
+#	-Wconversion \
+#	-Wmissing-prototypes \
+#	-Wmissing-declarations \
+#	-Winline -Wdisabled-optimization
 CFLAGS = -O2 $(CWFLAGS) -I. -D_FILE_OFFSET_BITS=64 $(FLAGS)
 DEBUGFLAGS = $(CFLAGS) -Wunused -gstabs+ -g2
 
@@ -96,7 +96,6 @@
 	heap_predicates.c						\
 	heap.c								\
 	current.c   							\
-	new_object.c   							\
 	ratios_predicates.c						\
 	atomic.c							\
 	gc_state.c   							\
@@ -107,7 +106,10 @@
 	dfs-mark.c							\
 	share.c								\
 	mark-compact.c							\
+	new_object.c   							\
 	garbage-collection.c						\
+	array-allocate.c						\
+	copy-thread.c							\
 	assumptions.c							\
 	gc_suffix.c
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c	2005-10-22 00:34:28 UTC (rev 4117)
@@ -10,6 +10,10 @@
   return 0 == a % b;
 }
 
+static inline bool isAlignedMax (uintmax_t a, uintmax_t b) {
+  return 0 == a % b;
+}
+
 static inline size_t alignDown (size_t a, size_t b) {
   assert (b >= 1);
   a -= a % b;
@@ -25,6 +29,14 @@
   return a;       
 }
 
+static inline uintmax_t alignMax (uintmax_t a, uintmax_t b) {
+  assert (b >= 1);
+  a += b - 1;
+  a -= a % b;
+  assert (isAligned (a, b));
+  return a;       
+}
+
 static inline size_t pad (GC_state s, size_t bytes, size_t extra) {
   return align (bytes + extra, s->alignment) - extra;
 }

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c	2005-10-22 00:34:28 UTC (rev 4117)
@@ -0,0 +1,108 @@
+/* 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.
+ */
+
+pointer GC_arrayAllocate (GC_state s, 
+                          size_t ensureBytesFree, 
+                          GC_arrayLength numElements, 
+                          GC_header header) {
+  uintmax_t arraySizeMax;
+  size_t arraySize;
+  size_t bytesPerElement;
+  uint16_t numNonObjptrs;
+  uint16_t numObjptrs;
+  pointer frontier;
+  pointer last;
+  pointer res;
+
+  splitHeader(s, header, NULL, NULL, &numNonObjptrs, &numObjptrs);
+  if (DEBUG)
+    fprintf (stderr, "GC_arrayAllocate (%zu, "FMTARRLEN", "FMTHDR")\n",
+             ensureBytesFree, numElements, header);
+  bytesPerElement = 
+    numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG) 
+    + (numObjptrs * OBJPTR_SIZE);
+  arraySizeMax = 
+    alignMax ((uintmax_t)bytesPerElement * (uintmax_t)numElements + GC_ARRAY_HEADER_SIZE,
+              s->alignment);
+  if (arraySizeMax >= (uintmax_t)SIZE_MAX)
+    die ("Out of memory: cannot allocate array with %"PRIuMAX" bytes.",
+         /*ullongToCommaString*/(arraySizeMax));
+  arraySize = (size_t)arraySizeMax;
+  if (arraySize < GC_ARRAY_HEADER_SIZE + WORD_SIZE)
+    /* Create space for forwarding pointer. */
+    arraySize = GC_ARRAY_HEADER_SIZE + WORD_SIZE;
+  if (DEBUG_ARRAY)
+    fprintf (stderr, "array with "FMTARRLEN" elts of size %zu and total size %zu.  Ensure %zu bytes free.\n",
+             numElements, bytesPerElement, 
+             /*uintToCommaString*/(arraySize),
+             /*uintToCommaString*/(ensureBytesFree));
+  if (arraySize >= s->controls.oldGenArraySize) {
+    enter (s);
+    doGC (s,  arraySize, ensureBytesFree, FALSE, TRUE);
+    leave (s);
+    frontier = s->heap.start + s->heap.oldGenSize;
+    last = frontier + arraySize;
+    s->heap.oldGenSize += arraySize;
+    s->cumulativeStatistics.bytesAllocated += arraySize;
+  } else {
+    size_t bytesRequested;
+    
+    bytesRequested = arraySize + ensureBytesFree;
+    if (bytesRequested > (size_t)(s->limitPlusSlop - s->frontier)) {
+      enter (s);
+      doGC (s, 0, bytesRequested, FALSE, TRUE);
+      leave (s);
+    }
+    frontier = s->frontier;
+    last = frontier + arraySize;
+    assert (isAlignedFrontier (s, last));
+    s->frontier = last;
+  }
+  *((GC_arrayCounter*)(frontier)) = 0;
+  frontier = frontier + GC_ARRAY_COUNTER_SIZE;
+  *((GC_arrayLength*)(frontier)) = numElements;
+  frontier = frontier + GC_ARRAY_LENGTH_SIZE;
+  *((GC_header*)(frontier)) = header;
+  frontier = frontier + GC_HEADER_SIZE;
+  res = frontier;
+  /* Initialize all pointers with BOGUS_OBJPTR. */
+  if (1 <= numObjptrs and 0 < numElements) {
+    pointer p;
+    
+    if (0 == numNonObjptrs)
+      for (p = frontier; 
+           p < last; 
+           p += OBJPTR_SIZE)
+        *((objptr*)p) = BOGUS_OBJPTR;
+    else
+      for (p = frontier; 
+           p < last; ) {
+        pointer next;
+        
+        p += numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
+        next = p + numObjptrs * OBJPTR_SIZE;
+        assert (next <= last);
+        while (p < next) {
+          *((objptr*)p) = BOGUS_OBJPTR;
+          p += OBJPTR_SIZE;
+        }
+      }
+  }
+  GC_profileAllocInc (s, arraySize);
+  if (DEBUG_ARRAY) {
+    fprintf (stderr, "GC_arrayAllocate done.  res = "FMTPTR"  frontier = "FMTPTR"\n",
+             (uintptr_t)res, (uintptr_t)s->frontier);
+    displayGCState (s, stderr);
+  }
+  assert (ensureBytesFree <= (size_t)(s->limitPlusSlop - s->frontier));
+  /* Unfortunately, the invariant isn't quite true here, because
+   * unless we did the GC, we never set s->currentThread->stack->used
+   * to reflect what the mutator did with stackTop.
+   */
+  return res;
+}       

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h	2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h	2005-10-22 00:34:28 UTC (rev 4117)
@@ -20,6 +20,8 @@
  */
 typedef uint32_t GC_arrayLength;
 #define GC_ARRAY_LENGTH_SIZE sizeof(GC_arrayLength)
+#define PRIxARRLEN PRIu32
+#define FMTARRLEN "%"PRIxARRLEN
 typedef GC_arrayLength GC_arrayCounter;
 #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)
@@ -29,8 +31,7 @@
  * Returns a pointer to the length for the array pointed to by p.
  */
 static inline GC_arrayLength* getArrayLengthp (pointer a) {
-  return (GC_arrayLength*)(a - GC_HEADER_SIZE 
-                           - GC_ARRAY_LENGTH_SIZE);
+  return (GC_arrayLength*)(a - GC_HEADER_SIZE - GC_ARRAY_LENGTH_SIZE);
 }
 
 /* getArrayLength (p)

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h	2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h	2005-10-22 00:34:28 UTC (rev 4117)
@@ -10,5 +10,6 @@
   size_t fixedHeap; /* If 0, then no fixed heap. */
   size_t maxHeap; /* if zero, then unlimited, else limit total heap */
   bool messages; /* Print a message at the start and end of each gc. */
+  size_t oldGenArraySize; /* Arrays larger are allocated in old gen, if possible. */
   bool summary; /* Print a summary of gc info when program exits. */
 };

Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c	2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c	2005-10-22 00:34:28 UTC (rev 4117)
@@ -0,0 +1,106 @@
+/* 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 GC_thread newThread (GC_state s, size_t stackSize) {
+  GC_stack stack;
+  GC_thread thread;
+
+  ensureFree (s, stackSizeTotalAligned (s, stackSize) + threadSize (s));
+  stack = newStack (s, stackSize, FALSE);
+  thread = (GC_thread) newObject (s, GC_THREAD_HEADER, 
+                                  threadSize (s), 
+                                  FALSE);
+  thread->bytesNeeded = 0;
+  thread->exnStack = BOGUS_EXN_STACK;
+  thread->stack = pointerToObjptr((pointer)stack, s->heap.start);
+  if (DEBUG_THREADS)
+    fprintf (stderr, FMTPTR" = newThreadOfSize (%zu)\n",
+             (uintptr_t)thread, stackSize);;
+  return thread;
+}
+
+static GC_thread copyThread (GC_state s, GC_thread from, size_t size) {
+  GC_thread to;
+
+  if (DEBUG_THREADS)
+    fprintf (stderr, "copyThread ("FMTPTR")\n", (uintptr_t)from);
+  /* newThread may do a GC, which invalidates from.
+   * Hence we need to stash from where the GC can find it.
+   */
+  s->savedThread = pointerToObjptr((pointer)from, s->heap.start);
+  to = newThread (s, size);
+  from = (GC_thread)(objptrToPointer(s->savedThread, s->heap.start));
+  s->savedThread = BOGUS_OBJPTR;
+  if (DEBUG_THREADS) {
+    fprintf (stderr, FMTPTR" = copyThread ("FMTPTR")\n",
+             (uintptr_t)to, (uintptr_t)from);
+  }
+  stackCopy (s, 
+             (GC_stack)(objptrToPointer(from->stack, s->heap.start)), 
+             (GC_stack)(objptrToPointer(to->stack, s->heap.start)));
+  to->bytesNeeded = from->bytesNeeded;
+  to->exnStack = from->exnStack;
+  return to;
+}
+
+void GC_copyCurrentThread (GC_state s) {
+  GC_thread fromThread;
+  GC_stack fromStack;
+  GC_thread toThread;
+  GC_stack toStack;
+        
+  if (DEBUG_THREADS)
+    fprintf (stderr, "GC_copyCurrentThread\n");
+  enter (s);
+  fromThread = (GC_thread)(objptrToPointer(s->currentThread, s->heap.start));
+  fromStack = (GC_stack)(objptrToPointer((objptr)(fromThread->stack), s->heap.start));
+  toThread = copyThread (s, fromThread, fromStack->used);
+  toStack = (GC_stack)(objptrToPointer((objptr)(toThread->stack), s->heap.start));
+  /* The following assert is no longer true, since alignment
+   * restrictions can force the reserved to be slightly larger than
+   * the used.
+   */
+  /* assert (fromStack->reserved == fromStack->used); */
+  assert (fromStack->reserved >= fromStack->used);
+  leave (s);
+  if (DEBUG_THREADS)
+    fprintf (stderr, FMTPTR" = GC_copyCurrentThread\n", (uintptr_t)toThread);
+  s->savedThread = pointerToObjptr((pointer)toThread, s->heap.start);
+}
+
+pointer GC_copyThread (GC_state s, pointer p) {
+  GC_thread fromThread;
+  GC_stack fromStack;
+  GC_thread toThread;
+  GC_stack toStack;
+
+  if (DEBUG_THREADS)
+    fprintf (stderr, "GC_copyThread ("FMTPTR")\n", (uintptr_t)p);
+  enter (s);
+  fromThread = (GC_thread)p;
+  fromStack = (GC_stack)(objptrToPointer((objptr)(fromThread->stack), s->heap.start));
+  /* The following assert is no longer true, since alignment
+   * restrictions can force the reserved to be slightly larger than
+   * the used.
+   */
+  /* assert (fromStack->reserved == fromStack->used); */
+  assert (fromStack->reserved >= fromStack->used);
+  toThread = copyThread (s, fromThread, fromStack->used);
+  /* The following assert is no longer true, since alignment
+   * restrictions can force the reserved to be slightly larger than
+   * the used.
+   */
+  toStack = (GC_stack)(objptrToPointer((objptr)(toThread->stack), s->heap.start));
+  /* assert (fromStack->reserved == fromStack->used); */
+  assert (fromStack->reserved >= fromStack->used);
+  leave (s);
+  if (DEBUG_THREADS)
+    fprintf (stderr, FMTPTR" = GC_copyThread ("FMTPTR")\n", 
+             (uintptr_t)toThread, (uintptr_t)fromThread);
+  return (pointer)toThread;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c	2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c	2005-10-22 00:34:28 UTC (rev 4117)
@@ -57,7 +57,7 @@
 }
 #endif
 
-/* mark (s, r, m, shc) 
+/* dfsMark (s, r, m, shc) 
  *
  * Sets all the mark bits in the object graph pointed to by r. 
  *
@@ -68,8 +68,8 @@
  *
  * It returns the total size in bytes of the objects marked.
  */
-size_t mark (GC_state s, pointer root,
-             GC_markMode mode, bool shouldHashCons) {
+size_t dfsMark (GC_state s, pointer root,
+                GC_markMode mode, bool shouldHashCons) {
   GC_header mark; /* Used to set or clear the mark bit. */
   size_t size; /* Total number of bytes marked. */
   pointer cur; /* The current object being marked. */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c	2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c	2005-10-22 00:34:28 UTC (rev 4117)
@@ -10,25 +10,25 @@
 /*                 Jonkers Mark-compact Collection                  */
 /* ---------------------------------------------------------------- */
 
-static inline void markGlobalTrue (GC_state s, objptr *opp) {
+static inline void dfsMarkTrue (GC_state s, objptr *opp) {
   pointer p;
 
   p = objptrToPointer (*opp, s->heap.start);
-  mark (s, p, MARK_MODE, TRUE);
+  dfsMark (s, p, MARK_MODE, TRUE);
 }
 
-static inline void markGlobalFalse (GC_state s, objptr *opp) {
+static inline void dfsMarkFalse (GC_state s, objptr *opp) {
   pointer p;
 
   p = objptrToPointer (*opp, s->heap.start);
-  mark (s, p, MARK_MODE, FALSE);
+  dfsMark (s, p, MARK_MODE, FALSE);
 }
 
-static inline void unmarkGlobal (GC_state s, objptr *opp) {
+static inline void dfsUnmark (GC_state s, objptr *opp) {
   pointer p;
 
   p = objptrToPointer (*opp, s->heap.start);
-  mark (s, p, UNMARK_MODE, FALSE);
+  dfsMark (s, p, UNMARK_MODE, FALSE);
 }
 
 static inline void threadInternal (GC_state s, objptr *opp) {
@@ -284,10 +284,10 @@
     s->cumulativeStatistics.bytesHashConsed = 0;
     s->cumulativeStatistics.numHashConsGCs++;
     s->objectHashTable = newHashTable (s);
-    foreachGlobalObjptr (s, markGlobalTrue);
+    foreachGlobalObjptr (s, dfsMarkTrue);
     destroyHashTable (s->objectHashTable);
   } else {
-    foreachGlobalObjptr (s, markGlobalFalse);
+    foreachGlobalObjptr (s, dfsMarkFalse);
   }
 /*   foreachGlobal (s, threadInternal); */
 /*   updateForwardPointers (s); */

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c	2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c	2005-10-22 00:34:28 UTC (rev 4117)
@@ -14,10 +14,10 @@
   if (DEBUG_SHARE or s->controls.messages)
     s->cumulativeStatistics.bytesHashConsed = 0;
   // Don't hash cons during the first round of marking.
-  total = mark (s, object, MARK_MODE, FALSE);
+  total = dfsMark (s, object, MARK_MODE, FALSE);
   s->objectHashTable = newHashTable (s);
   // Hash cons during the second round of marking.
-  mark (s, object, UNMARK_MODE, TRUE);
+  dfsMark (s, object, UNMARK_MODE, TRUE);
   destroyHashTable (s->objectHashTable);
   if (DEBUG_SHARE or s->controls.messages)
     bytesHashConsedMessage (s, total);

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c	2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c	2005-10-22 00:34:28 UTC (rev 4117)
@@ -6,12 +6,14 @@
  * See the file MLton-LICENSE for details.
  */
 
+#define BOGUS_EXN_STACK 0xFFFFFFFF
+
 void displayThread (GC_state s,
                     GC_thread thread, 
                     FILE *stream) {
   fprintf(stream,
           "\t\texnStack = %"PRIu32"\n"
-          "\t\tbytesNeeded = %"PRIu32"\n"
+          "\t\tbytesNeeded = %zu\n"
           "\t\tstack = "FMTOBJPTR"\n",
           thread->exnStack,
           thread->bytesNeeded,
@@ -19,3 +21,17 @@
   displayStack (s, (GC_stack)(objptrToPointer (thread->stack, s->heap.start)),
                 stream);
 }
+
+static inline size_t threadSize (GC_state s) {
+  size_t res;
+
+  res = GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread);
+  /* The following assert depends on struct GC_thread being the right
+   * size.  Right now, it happens that res = 16, which is aligned mod
+   * 4 and mod 8, which is all that we need.  If the struct every
+   * changes (possible) or we need more alignment (doubtful), we may
+   * need to put some padding at the beginning.
+   */
+  assert (isAligned (res, s->alignment));
+  return res;
+}

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h	2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h	2005-10-22 00:34:28 UTC (rev 4117)
@@ -13,11 +13,11 @@
    * Furthermore, the exnStack field must be first, because the native
    * codegen depends on this (which is bad and should be fixed).
    */
-  uint32_t exnStack;     /* An offset added to stackBottom that specifies 
-                          * where the top of the exnStack is.
-                          */
-  uint32_t bytesNeeded;  /* The number of bytes needed when returning
-                          * to this thread.
-                          */
-  objptr stack;          /* The stack for this thread. */
+  uint32_t exnStack;  /* An offset added to stackBottom that specifies 
+                       * where the top of the exnStack is.
+                       */
+  size_t bytesNeeded; /* The number of bytes needed when returning
+                       * to this thread.
+                       */
+  objptr stack;       /* The stack for this thread. */
 } *GC_thread;