[MLton-commit] r4080
Matthew Fluet
MLton@mlton.org
Thu, 8 Sep 2005 19:56:22 -0700
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;