[MLton-devel] cvs commit: thread bug fixes
Stephen Weeks
sweeks@users.sourceforge.net
Fri, 19 Jul 2002 17:20:24 -0700
sweeks 02/07/19 17:20:24
Modified: basis-library/misc primitive.sml
basis-library/mlton cont.sml thread.sml
mlton/atoms prim.fun
mlton/backend rssa.sig ssa-to-rssa.fun
runtime gc.c gc.h mlton-basis.h
runtime/basis Thread.c
Log:
Fixed two bugs with threads/signals. The first was a bug in how the basis
library used GC_copyCurrentThread, which had returned the copied thread as a
result of the C function. This worked fine in the thread that made the copy,
but unfortunately, this caused problems when switching to the copy of the
thread, because the copy also assumed that a result would be returned. Of
course when switching there was no result, so whatever happened to be in %eax
was taken as the result. The fix was to have GC_copyCurrentThread put its
result in gcState.saved, and only to access this result in the thread that makes
the copy.
The second bug happens when a thread fails a limit check for k bytes due to a
signal, and the signal handler switches to another thread. The problem is that
when switching back to the original thread, there was never a check for the k
bytes. To fix this, I put a limit check at the end of GC_switchToThread that
checks to make sure that the bytesFree of the thread being switched to is
available. I also changed thread switch in the backend so that it
ensuresBytesFree, and so that whenever a thread is switched out, it sets
bytesFree.
Thread switching is now quite a bit slower than it used to be, since it has to
go through a couple of C calls and do a little bit of redundant work. If we
ever need to, we can speed it up again by inlining GC_switchToThread in the
backend (not the codegens!).
Revision Changes Path
1.31 +15 -1 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- primitive.sml 7 Jul 2002 21:41:51 -0000 1.30
+++ primitive.sml 20 Jul 2002 00:20:24 -0000 1.31
@@ -564,10 +564,24 @@
else _prim "Thread_atomicEnd": unit -> unit; ()
else ()
val copy = _prim "Thread_copy": preThread -> thread;
- val copyCurrent = _prim "Thread_copyCurrent": unit -> preThread;
+ (* copyCurrent's result is accesible via savedPre ().
+ * It is not possible to have the type of copyCurrent as
+ * unit -> preThread, because there are two different ways to
+ * return from the call to copyCurrent. One way is the direct
+ * obvious way, in the thread that called copyCurrent. That one,
+ * of course, wants to call savedPre (). However, another way to
+ * return is by making a copy of the preThread and then switching
+ * to it. In that case, there is no preThread to return. Making
+ * copyCurrent return a preThread creates nasty bugs where the
+ * return code from the CCall expects to see a preThread result
+ * according to the C return convention, but there isn't one when
+ * switching to a copy.
+ *)
+ val copyCurrent = _prim "Thread_copyCurrent": unit -> unit;
val current = _prim "Thread_current": unit -> thread;
val finishHandler = _ffi "Thread_finishHandler": unit -> unit;
val saved = _ffi "Thread_saved": unit -> thread;
+ val savedPre = _ffi "Thread_saved": unit -> preThread;
val setHandler = _ffi "Thread_setHandler": thread -> unit;
val switchTo = _prim "Thread_switchTo": thread -> unit;
end
1.8 +18 -14 mlton/basis-library/mlton/cont.sml
Index: cont.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/cont.sml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- cont.sml 7 Jul 2002 21:41:51 -0000 1.7
+++ cont.sml 20 Jul 2002 00:20:24 -0000 1.8
@@ -28,26 +28,30 @@
| Clear
val r: 'a state ref = ref (Original f)
val _ = Thread.atomicBegin () (* Match 1 *)
- val t = Thread.copyCurrent ()
+ val _ = Thread.copyCurrent ()
in
case (!r before r := Clear) of
Clear => raise Fail "callcc saw Clear"
| Copy v => (Thread.atomicEnd () (* Match 2 *)
; v ())
| Original f =>
- (Thread.atomicEnd () (* Match 1 *)
- ; f (fn v =>
- let
- val _ = Thread.atomicBegin () (* Match 2 *)
- val _ = r := Copy v
- val new = Thread.copy t
- (* The following Thread.atomicBegin ()
- * is matched by Thread.switchTo.
- *)
- val _ = Thread.atomicBegin ()
- in
- Thread.switchTo new
- end))
+ let
+ val t = Thread.savedPre ()
+ in
+ Thread.atomicEnd () (* Match 1 *)
+ ; f (fn v =>
+ let
+ val _ = Thread.atomicBegin () (* Match 2 *)
+ val _ = r := Copy v
+ val new = Thread.copy t
+ (* The following Thread.atomicBegin ()
+ * is matched by Thread.switchTo.
+ *)
+ val _ = Thread.atomicBegin ()
+ in
+ Thread.switchTo new
+ end)
+ end
end))
fun ('a, 'b) throw' (k: 'a t, v: unit -> 'a): 'b =
1.11 +12 -10 mlton/basis-library/mlton/thread.sml
Index: thread.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/thread.sml,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- thread.sml 7 Jul 2002 21:41:51 -0000 1.10
+++ thread.sml 20 Jul 2002 00:20:24 -0000 1.11
@@ -39,15 +39,17 @@
local
val func: (unit -> unit) option ref = ref NONE
- val base: Prim.preThread = Prim.copyCurrent ()
- val _ = (case !func of
- NONE => ()
- | SOME x =>
- (func := NONE
- (* Close the atomicBegin of the thread that switched to me. *)
- ; atomicEnd ()
- ; (x () handle e => Exn.topLevelHandler e)
- ; die "Thread didn't exit properly.\n"))
+ val base: Prim.preThread =
+ (Prim.copyCurrent ()
+ ; (case !func of
+ NONE => Prim.savedPre ()
+ | SOME x =>
+ (* This branch never returns. *)
+ (func := NONE
+ (* Close the atomicBegin of the thread that switched to me. *)
+ ; atomicEnd ()
+ ; (x () handle e => Exn.topLevelHandler e)
+ ; die "Thread didn't exit properly.\n")))
val switching = ref false
in
fun ('a, 'b) switch'NoAtomicBegin (f: 'a t -> 'b t * (unit -> 'b)): 'a =
@@ -123,7 +125,7 @@
val _ =
case !r of
Paused (f, _) => f (fn () => ())
- | _ => raise Fail "setHandler saw strange pause"
+ | _ => raise Fail "setHandler saw strange Paused"
in
(t, fn () => ())
end)
1.30 +1 -1 mlton/mlton/atoms/prim.fun
Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- prim.fun 7 Jul 2002 21:41:51 -0000 1.29
+++ prim.fun 20 Jul 2002 00:20:24 -0000 1.30
@@ -371,7 +371,7 @@
(Thread_atomicEnd, SideEffect, "Thread_atomicEnd"),
(Thread_canHandle, DependsOnState, "Thread_canHandle"),
(Thread_copy, Moveable, "Thread_copy"),
- (Thread_copyCurrent, DependsOnState, "Thread_copyCurrent"),
+ (Thread_copyCurrent, SideEffect, "Thread_copyCurrent"),
(Thread_current, DependsOnState, "Thread_current"),
(Thread_switchTo, SideEffect, "Thread_switchTo"),
(Vector_fromArray, DependsOnState, "Vector_fromArray"),
1.13 +5 -2 mlton/mlton/backend/rssa.sig
Index: rssa.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.sig,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- rssa.sig 6 Jul 2002 17:22:05 -0000 1.12
+++ rssa.sig 20 Jul 2002 00:20:24 -0000 1.13
@@ -63,8 +63,11 @@
| CastInt of t
| CastWord of t
| Const of Const.t
- (* EnsuresBytesFree is a pseudo-op used by GC_allocateArray, and
- * is replaced by the limit check pass with a real operand.
+ (* EnsuresBytesFree is a pseudo-op used by C functions (like
+ * GC_allocateArray) that take a number of bytes as an argument
+ * and ensure that that number of bytes is free upon return.
+ * EnsuresBytesFree is replaced by the limit check pass with
+ * a real operand.
*)
| EnsuresBytesFree
| File (* expand by codegen into string constant *)
1.16 +8 -9 mlton/mlton/backend/ssa-to-rssa.fun
Index: ssa-to-rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/ssa-to-rssa.fun,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- ssa-to-rssa.fun 7 Jul 2002 21:41:51 -0000 1.15
+++ ssa-to-rssa.fun 20 Jul 2002 00:20:24 -0000 1.16
@@ -75,7 +75,7 @@
modifiesStackTop = true,
name = "GC_copyCurrentThread",
needsArrayInit = false,
- returnTy = SOME Type.pointer}
+ returnTy = NONE}
val copyThread =
T {bytesNeeded = NONE,
@@ -112,7 +112,7 @@
val threadSwitchTo =
T {bytesNeeded = NONE,
- ensuresBytesFree = false,
+ ensuresBytesFree = true,
mayGC = true,
maySwitchThreads = true,
modifiesFrontier = true,
@@ -655,17 +655,13 @@
| Thread_copyCurrent =>
let
val func = CFunction.copyCurrentThread
- val t = Var.newNoname ()
val l =
- newBlock {args = Vector.new1 (t, Type.pointer),
+ newBlock {args = Vector.new0 (),
kind = Kind.CReturn {func = func},
profileInfo = profileInfo,
statements = Vector.new0 (),
transfer =
- (Goto {args = (Vector.new1
- (Operand.Var
- {var = t,
- ty = Type.pointer})),
+ (Goto {args = Vector.new0 (),
dst = return})}
in
Transfer.CCall
@@ -1228,7 +1224,10 @@
vos args]),
func = CFunction.copyThread}
| Thread_switchTo =>
- simpleCCall CFunction.threadSwitchTo
+ ccall {args = (Vector.new2
+ (varOp (a 0),
+ Operand.EnsuresBytesFree)),
+ func = CFunction.threadSwitchTo}
| Vector_fromArray => move (varOp (a 0))
| Vector_sub =>
(case targ () of
1.62 +194 -175 mlton/runtime/gc.c
Index: gc.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.c,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- gc.c 16 Jul 2002 00:49:27 -0000 1.61
+++ gc.c 20 Jul 2002 00:20:24 -0000 1.62
@@ -49,6 +49,7 @@
DEBUG_MEM = FALSE,
DEBUG_RESIZING = FALSE,
DEBUG_SIGNALS = FALSE,
+ DEBUG_STACKS = FALSE,
DEBUG_THREADS = FALSE,
FORWARDED = 0xFFFFFFFF,
HEADER_SIZE = WORD_SIZE,
@@ -453,8 +454,6 @@
/* stackSlop returns the amount of "slop" space needed between the top of
* the stack and the end of the stack space.
- * If you change this, make sure and change Thread_switchTo in ccodegen.h
- * and thread_switchTo in x86-generate-transfers.sml.
*/
static inline uint stackSlop (GC_state s) {
return 2 * s->maxFrameSize;
@@ -464,31 +463,20 @@
return stackSlop (s);
}
-static inline uint
-stackBytes (uint size)
-{
+static inline uint stackBytes (uint size) {
return wordAlign (HEADER_SIZE + sizeof (struct GC_stack) + size);
}
-/* If you change this, make sure and change Thread_switchTo in ccodegen.h
- * and thread_switchTo in x86-generate-transfers.sml.
- */
static inline pointer stackBottom (GC_stack stack) {
return ((pointer)stack) + sizeof (struct GC_stack);
}
/* Pointer to the topmost word in use on the stack. */
-/* If you change this, make sure and change Thread_switchTo in ccodegen.h
- * and thread_switchTo in x86-generate-transfers.sml.
- */
static inline pointer stackTop (GC_stack stack) {
- return stackBottom(stack) + stack->used;
+ return stackBottom (stack) + stack->used;
}
/* The maximum value stackTop may take on. */
-/* If you change this, make sure and change Thread_switchTo in ccodegen.h
- * and thread_switchTo in x86-generate-transfers.sml.
- */
static inline pointer stackLimit (GC_state s, GC_stack stack) {
return stackBottom (stack) + stack->reserved - stackSlop (s);
}
@@ -535,10 +523,14 @@
static inline pointer object (GC_state s, uint header, uint bytesRequested) {
pointer result;
- assert (s->frontier + bytesRequested <= s->limit);
+ assert (bytesRequested <= s->limitPlusSlop - s->frontier);
assert (isWordAligned (bytesRequested));
*(uint*)s->frontier = header;
result = s->frontier + HEADER_SIZE;
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "frontier changed from 0x%08x to 0x%08x\n",
+ (uint)s->frontier,
+ (uint)(s->frontier + bytesRequested));
s->frontier += bytesRequested;
return result;
}
@@ -549,7 +541,7 @@
stack = (GC_stack) object (s, STACK_HEADER, stackBytes (size));
stack->reserved = size;
stack->used = 0;
- if (DEBUG_DETAILED)
+ if (DEBUG_THREADS)
fprintf (stderr, "0x%x = newStack (%u)\n", (uint)stack, size);
return stack;
}
@@ -563,24 +555,19 @@
s->stackLimit = stackLimit (s, stack);
}
-static inline void switchToThread (GC_state s, GC_thread t) {
- s->currentThread = t;
- setStack(s);
-}
-
static inline void stackCopy (GC_stack from, GC_stack to) {
assert (from->used <= to->reserved);
to->used = from->used;
+ if (DEBUG_STACKS)
+ fprintf (stderr, "stackCopy from 0x%08x to 0x%08x of length %u\n",
+ (uint) stackBottom (from),
+ (uint) stackBottom (to),
+ from->used);
memcpy (stackBottom (to), stackBottom (from), from->used);
}
/* Number of bytes used by the stack. */
-/* If you change this, make sure and change Thread_switchTo in ccodegen.h
- * and thread_switchTo in x86-generate-transfers.sml.
- */
-static inline uint
-currentStackUsed (GC_state s)
-{
+static inline uint currentStackUsed (GC_state s) {
return s->stackTop - s->stackBottom;
}
@@ -708,10 +695,10 @@
returnAddress = *(word*) (top - WORD_SIZE);
if (DEBUG)
fprintf(stderr,
- " top = %d return address = %u.\n",
+ " top = %d return address = 0x%08x.\n",
top - bottom,
returnAddress);
- layout = getFrameLayout(s, returnAddress);
+ layout = getFrameLayout (s, returnAddress);
frameOffsets = layout->offsets;
top -= layout->numBytes;
for (i = 0 ; i < frameOffsets[0] ; ++i) {
@@ -794,81 +781,61 @@
return (s->base <= p and p < s->frontier);
}
-static inline void
-assertIsInFromSpace (GC_state s, pointer *p)
-{
+static inline void assertIsInFromSpace (GC_state s, pointer *p) {
#ifndef NODEBUG
unless (isInFromSpace (s, *p))
- die ("gc.c: assertIsInFromSpace (0x%x);\n", (uint)*p);
+ die ("gc.c: assertIsInFromSpace p = 0x%08x *p = 0x%08x);\n",
+ (uint)p, (uint)*p);
#endif
}
-static inline bool
-isInToSpace (GC_state s, pointer p)
-{
+static inline bool isInToSpace (GC_state s, pointer p) {
return (not(GC_isPointer(p))
or (s->toBase <= p and p < s->toBase + s->toSize));
}
-static bool
-invariant (GC_state s)
-{
+static bool invariant (GC_state s) {
/* would be nice to add divisiblity by pagesize of various things */
+ int i;
+ GC_stack stack;
+// if (DEBUG)
+// fprintf (stderr, "invariant\n");
/* Frame layouts */
- {
- int i;
-
- for (i = 0; i < s->maxFrameIndex; ++i) {
- GC_frameLayout *layout;
-
- layout = &(s->frameLayouts[i]);
- if (layout->numBytes > 0) {
- GC_offsets offsets;
- int j;
-
- assert(layout->numBytes <= s->maxFrameSize);
- offsets = layout->offsets;
- for (j = 0; j < offsets[0]; ++j)
- assert(offsets[j + 1] < layout->numBytes);
- }
+ for (i = 0; i < s->maxFrameIndex; ++i) {
+ GC_frameLayout *layout;
+ layout = &(s->frameLayouts[i]);
+ if (layout->numBytes > 0) {
+ GC_offsets offsets;
+ int j;
+ assert(layout->numBytes <= s->maxFrameSize);
+ offsets = layout->offsets;
+ for (j = 0; j < offsets[0]; ++j)
+ assert(offsets[j + 1] < layout->numBytes);
}
}
/* Heap */
- assert(isWordAligned((uint)s->frontier));
- assert(s->base <= s->frontier);
- assert(0 == s->fromSize
- or (s->frontier <= s->limit + LIMIT_SLOP
- and s->limit == s->base + s->fromSize - LIMIT_SLOP));
- assert(s->toBase == NULL or s->toSize == s->fromSize);
+ assert (isWordAligned ((uint)s->frontier));
+ assert (s->base <= s->frontier);
+ assert (0 == s->fromSize
+ or (s->frontier <= s->limitPlusSlop
+ and s->limitPlusSlop == s->base + s->fromSize
+ and s->limit == s->limitPlusSlop - LIMIT_SLOP));
+ assert (s->toBase == NULL or s->toSize == s->fromSize);
/* Check that all pointers are into from space. */
- foreachGlobal(s, assertIsInFromSpace);
- foreachPointerInRange(s, s->base, &s->frontier, assertIsInFromSpace);
+ foreachGlobal (s, assertIsInFromSpace);
+ foreachPointerInRange (s, s->base, &s->frontier, assertIsInFromSpace);
/* Current thread. */
- {
-/* uint offset; */
- GC_stack stack;
-
- stack = s->currentThread->stack;
- assert(isWordAligned(stack->reserved));
- assert(s->stackBottom == stackBottom(stack));
- assert(s->stackTop == stackTop(stack));
- assert(s->stackLimit == stackLimit(s, stack));
- assert(stack->used == currentStackUsed(s));
- assert(stack->used < stack->reserved);
- assert(s->stackBottom <= s->stackTop);
-/* Can't walk down the exception stack these days, because there is no
- * guarantee that the handler link and slot are next to each other.
- */
-/* for (offset = s->currentThread->exnStack; */
-/* offset != BOGUS_EXN_STACK; ) { */
-/* unless (s->stackBottom + offset <= s->stackTop) */
-/* fprintf(stderr, "s->stackBottom = %d offset = %d s->stackTop = %d\n", (uint)(s->stackBottom), offset, (uint)(s->stackTop)); */
-/* assert(s->stackBottom + offset <= s->stackTop); */
-/* offset = *(uint*)(s->stackBottom + offset + WORD_SIZE); */
-/* } */
- }
-
+ stack = s->currentThread->stack;
+ assert (isWordAligned (stack->reserved));
+ assert (s->stackBottom == stackBottom (stack));
+ assert (s->stackTop == stackTop (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;
}
@@ -900,25 +867,32 @@
* from within an ML signal handler.
*/
void enter (GC_state s) {
+ if (DEBUG)
+ fprintf (stderr, "enter\n");
/* used needs to be set because the mutator has changed s->stackTop. */
s->currentThread->stack->used = currentStackUsed (s);
if (DEBUG)
GC_display (s, stderr);
unless (s->inSignalHandler) {
blockSignals (s);
- if (s->limit == 0)
+ if (0 == s->limit)
s->limit = s->limitPlusSlop - LIMIT_SLOP;
}
assert (invariant (s));
+ if (DEBUG)
+ fprintf (stderr, "enter ok\n");
}
-void leave (GC_state s)
-{
+void leave (GC_state s) {
+ if (DEBUG)
+ fprintf (stderr, "leave\n");
assert (mutatorInvariant (s));
if (s->signalIsPending and 0 == s->canHandle)
s->limit = 0;
unless (s->inSignalHandler)
unblockSignals (s);
+ if (DEBUG)
+ fprintf (stderr, "leave ok\n");
}
static inline void releaseFromSpace (GC_state s) {
@@ -944,11 +918,10 @@
/* ---------------------------------------------------------------- */
void GC_display (GC_state s, FILE *stream) {
- fprintf (stream, "GC state\n\tbase = 0x%x\n\tfrontier - base = %u\n\tlimit - base = %u\n\tlimit - frontier = %d\n",
+ fprintf (stream, "GC state\n\tbase = 0x%x\n\tfrontier - base = %u\n\tlimitPlusSlop - frontier = %d\n",
(uint) s->base,
s->frontier - s->base,
- s->limit - s->base,
- s->limit - s->frontier);
+ s->limitPlusSlop - s->frontier);
fprintf (stream, "\tcanHandle = %d\n", s->canHandle);
fprintf (stream, "\texnStack = %u bytesNeeded = %u reserved = %u used = %u\n",
s->currentThread->exnStack,
@@ -1860,7 +1833,7 @@
size = 2 * s->currentThread->stack->reserved;
assert (stackBytes (size) <= s->limitPlusSlop - s->frontier);
- if (DEBUG or s->messages)
+ if (DEBUG_STACKS or s->messages)
fprintf (stderr, "Growing stack to size %u.\n", size);
if (size > s->maxStackSizeSeen)
s->maxStackSizeSeen = size;
@@ -1925,16 +1898,69 @@
}
if (DEBUG)
GC_display (s, stderr);
+ assert (bytesRequested <= s->limitPlusSlop - s->frontier);
assert (invariant (s));
}
+/* ensureFree (s, b) ensures that upon return
+ * b <= s->limitPlusSlop - s->frontier
+ */
+static inline void ensureFree (GC_state s, uint b) {
+ assert (s->frontier <= s->limitPlusSlop);
+ if (b > s->limitPlusSlop - s->frontier)
+ doGC (s, b);
+ assert (b <= s->limitPlusSlop - s->frontier);
+}
+
+static inline void switchToThread (GC_state s, GC_thread t) {
+ if (DEBUG_THREADS)
+ fprintf (stderr, "switchToThread (0x%08x) used = %u reserved = %u\n",
+ (uint)t, t->stack->used, t->stack->reserved);
+ assert (stackTopIsOk (s, t->stack));
+ s->currentThread = t;
+ setStack (s);
+ ensureFree (s, t->bytesNeeded);
+ /* Can not refer to t, because ensureFree may have GC'ed. */
+ assert (s->currentThread->bytesNeeded <= s->limitPlusSlop - s->frontier);
+}
+
+void GC_switchToThread (GC_state s, GC_thread t) {
+ if (DEBUG_THREADS)
+ fprintf (stderr, "GC_switchToThread (0x%08x)\n", (uint)t);
+ if (FALSE) {
+ /* This branch is slower than the else branch, especially
+ * when debugging is turned on, because it does an invariant
+ * check on every thread switch.
+ * So, we'll stick with the else branch for now.
+ */
+ enter (s);
+ switchToThread (s, t);
+ leave (s);
+ } else {
+ s->currentThread->stack->used = currentStackUsed (s);
+ s->currentThread = t;
+ setStack (s);
+ if (t->bytesNeeded > s->limitPlusSlop - s->frontier) {
+ enter (s);
+ doGC (s, t->bytesNeeded);
+ leave (s);
+ }
+ }
+ /* Can not refer to t, because we may have GC'ed. */
+ assert (s->currentThread->bytesNeeded <= s->limitPlusSlop - s->frontier);
+}
+
void GC_gc (GC_state s, uint bytesRequested, bool force,
string file, int line) {
uint stackBytesRequested;
enter (s);
+ /* When the mutator requests zero bytes, it may actually need as much
+ * as LIMIT_SLOP.
+ */
+ if (0 == bytesRequested)
+ bytesRequested = LIMIT_SLOP;
s->currentThread->bytesNeeded = bytesRequested;
-start:
stackBytesRequested = getStackBytesRequested (s);
if (DEBUG) {
fprintf (stderr, "%s %d: ", file, line);
@@ -1944,7 +1970,7 @@
}
if (force or
(W64)(W32)s->frontier + (W64)bytesRequested
- + (W64)stackBytesRequested > (W64)(W32)s->limit) {
+ + (W64)stackBytesRequested > (W64)(W32)s->limitPlusSlop) {
if (s->messages)
fprintf(stderr, "%s %d: doGC\n", file, line);
/* This GC will grow the stack, if necessary. */
@@ -1953,12 +1979,12 @@
growStack (s);
else {
/* Switch to the signal handler thread. */
- assert (0 == s->canHandle);
if (DEBUG_SIGNALS) {
- fprintf(stderr, "switching to signal handler\n");
- GC_display(s, stderr);
+ fprintf (stderr, "switching to signal handler\n");
+ GC_display (s, stderr);
}
- assert(s->signalIsPending);
+ assert (0 == s->canHandle);
+ assert (s->signalIsPending);
s->signalIsPending = FALSE;
s->inSignalHandler = TRUE;
s->savedThread = s->currentThread;
@@ -1969,19 +1995,9 @@
*/
s->canHandle = 2;
switchToThread (s, s->signalHandler);
- bytesRequested = s->currentThread->bytesNeeded;
- assert (0 == bytesRequested);
- if (bytesRequested > s->limit - s->frontier)
- goto start;
- }
- assert (s->currentThread->bytesNeeded <= s->limit - s->frontier);
- /* The enter and leave must be outside the start loop. If they
- * were inside and force == TRUE, a signal handler could intervene just
- * before the enter or just after the leave, which would set
- * limit to 0 and cause the while loop to go forever, performing a GC
- * at each iteration and never switching to the signal handler.
- */
- leave(s);
+ }
+ assert (s->currentThread->bytesNeeded <= s->limitPlusSlop - s->frontier);
+ leave (s);
}
/* ---------------------------------------------------------------- */
@@ -2035,7 +2051,7 @@
res = (pointer)frontier;
if (1 == numPointers)
for ( ; frontier < last; frontier++)
- *frontier = 0x1;
+ *frontier = BOGUS_POINTER;
s->frontier = (pointer)last;
/* Unfortunately, the invariant isn't quite true here, because unless we
* did the GC, we never set s->currentThread->stack->used to reflect
@@ -2051,12 +2067,6 @@
return res;
}
-static inline void ensureFree (GC_state s, uint bytesRequested) {
- if (bytesRequested > s->limit - s->frontier) {
- doGC (s, bytesRequested);
- }
-}
-
/* ---------------------------------------------------------------- */
/* Threads */
/* ---------------------------------------------------------------- */
@@ -2078,7 +2088,7 @@
t = (GC_thread) object (s, THREAD_HEADER, threadBytes ());
t->exnStack = BOGUS_EXN_STACK;
t->stack = stack;
- if (DEBUG_DETAILED)
+ if (DEBUG_THREADS)
fprintf (stderr, "0x%x = newThreadOfSize (%u)\n",
(uint)t, stackSize);;
return t;
@@ -2087,21 +2097,27 @@
static inline GC_thread copyThread (GC_state s, GC_thread from, uint size) {
GC_thread to;
+ if (DEBUG_THREADS)
+ fprintf (stderr, "copyThread (0x%08x)\n", (uint)from);
/* newThreadOfSize may do a GC, which invalidates from.
* Hence we need to stash from where the GC can find it.
*/
s->savedThread = from;
- to = newThreadOfSize (s, size);
- if (DEBUG_THREADS)
+ to = newThreadOfSize (s, size);
+ from = s->savedThread;
+ s->savedThread = BOGUS_THREAD;
+ if (DEBUG_THREADS) {
+ fprintf (stderr, "free space = %u\n",
+ s->limitPlusSlop - s->frontier);
fprintf (stderr, "0x%08x = copyThread (0x%08x)\n",
(uint)to, (uint)from);
- from = s->savedThread;
+ }
stackCopy (from->stack, to->stack);
to->exnStack = from->exnStack;
return to;
}
-pointer GC_copyCurrentThread (GC_state s) {
+void GC_copyCurrentThread (GC_state s) {
GC_thread t;
GC_thread res;
@@ -2114,17 +2130,20 @@
leave (s);
if (DEBUG_THREADS)
fprintf (stderr, "0x%08x = GC_copyCurrentThread\n", (uint)res);
- return (pointer)res;
+ s->savedThread = res;
}
-pointer GC_copyThread (GC_state s, GC_thread t) {
+pointer GC_copyThread (GC_state s, pointer thread) {
GC_thread res;
+ GC_thread t;
+ t = (GC_thread)thread;
if (DEBUG_THREADS)
fprintf (stderr, "GC_copyThread (0x%08x)\n", (uint)t);
enter (s);
assert (t->stack->reserved == t->stack->used);
res = copyThread (s, t, stackNeedsReserved (s, t->stack));
+ assert (stackTopIsOk (s, res->stack));
leave (s);
return (pointer)res;
}
@@ -2349,7 +2368,49 @@
s->toBase = NULL;
switchToThread (s, newThreadOfSize (s, initialStackSize (s)));
assert (initialThreadBytes (s) == s->frontier - s->base);
- assert (s->frontier + s->bytesLive <= s->limit);
+ assert (s->frontier + s->bytesLive <= s->limitPlusSlop);
+ assert (mutatorInvariant (s));
+}
+
+/* worldTerminator is used to separate the human readable messages at the
+ * beginning of the world file from the machine readable data.
+ */
+static const char worldTerminator = '\000';
+
+static void loadWorld (GC_state s,
+ char *fileName,
+ void (*loadGlobals)(FILE *file)) {
+ FILE *file;
+ uint heapSize, magic;
+ pointer base, frontier;
+ char c;
+
+ file = sfopen(fileName, "rb");
+ until ((c = fgetc(file)) == worldTerminator or EOF == c);
+ if (EOF == c) die("Invalid world.");
+ magic = sfreadUint(file);
+ unless (s->magic == magic)
+ die("Invalid world: wrong magic number.");
+ base = (pointer)sfreadUint(file);
+ frontier = (pointer)sfreadUint(file);
+ s->currentThread = (GC_thread)sfreadUint(file);
+ s->signalHandler = (GC_thread)sfreadUint(file);
+ heapSize = frontier - base;
+ s->bytesLive = heapSize;
+ fromSpace (s, heapSize);
+ sfread (s->base, 1, heapSize, file);
+ s->frontier = s->base + heapSize;
+ (*loadGlobals)(file);
+ unless (EOF == fgetc (file))
+ die("Invalid world: junk at end of file.");
+ fclose(file);
+ /* translateHeap must occur after loading the heap and globals, since it
+ * changes pointers in all of them.
+ */
+ translateHeap (s, base, s->base, heapSize);
+ setStack (s);
+ s->toSize = 0;
+ s->toBase = NULL;
assert (mutatorInvariant (s));
}
@@ -2443,12 +2504,12 @@
}
setMemInfo(s);
if (DEBUG or DEBUG_RESIZING)
- fprintf(stderr, "totalRam = %u totalSwap = %u\n",
- s->totalRam, s->totalSwap);
+ fprintf (stderr, "totalRam = %u totalSwap = %u\n",
+ s->totalRam, s->totalSwap);
if (s->isOriginal)
- newWorld(s);
+ newWorld (s);
else
- GC_loadWorld (s, worldFile, loadGlobals);
+ loadWorld (s, worldFile, loadGlobals);
return i;
}
@@ -2560,48 +2621,6 @@
s->signalIsPending = TRUE;
if (DEBUG_SIGNALS)
fprintf (stderr, "GC_handler done\n");
-}
-
-/* worldTerminator is used to separate the human readable messages at the
- * beginning of the world file from the machine readable data.
- */
-static const char worldTerminator = '\000';
-
-void GC_loadWorld (GC_state s,
- char *fileName,
- void (*loadGlobals)(FILE *file)) {
- FILE *file;
- uint heapSize, magic;
- pointer base, frontier;
- char c;
-
- file = sfopen(fileName, "rb");
- until ((c = fgetc(file)) == worldTerminator or EOF == c);
- if (EOF == c) die("Invalid world.");
- magic = sfreadUint(file);
- unless (s->magic == magic)
- die("Invalid world: wrong magic number.");
- base = (pointer)sfreadUint(file);
- frontier = (pointer)sfreadUint(file);
- s->currentThread = (GC_thread)sfreadUint(file);
- s->signalHandler = (GC_thread)sfreadUint(file);
- heapSize = frontier - base;
- s->bytesLive = heapSize;
- fromSpace (s, heapSize);
- sfread (s->base, 1, heapSize, file);
- s->frontier = s->base + heapSize;
- (*loadGlobals)(file);
- unless (EOF == fgetc (file))
- die("Invalid world: junk at end of file.");
- fclose(file);
- /* translateHeap must occur after loading the heap and globals, since it
- * changes pointers in all of them.
- */
- translateHeap (s, base, s->base, heapSize);
- setStack (s);
- s->toSize = 0;
- s->toBase = NULL;
- assert (mutatorInvariant (s));
}
uint GC_size (GC_state s, pointer root) {
1.29 +8 -10 mlton/runtime/gc.h
Index: gc.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.h,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- gc.h 12 Jul 2002 04:24:32 -0000 1.28
+++ gc.h 20 Jul 2002 00:20:24 -0000 1.29
@@ -240,8 +240,7 @@
/* savedThread is only set
* when executing a signal handler. It is set to the thread that
* was running when the signal arrived.
- * or by GC_copyThread and GC_copyCurrentThread, which used it to store
- * their result.
+ * GC_copyCurrentThread also uses it to store its result.
*/
GC_thread savedThread;
/* Save globals writes out the values of all of the globals to fd. */
@@ -311,11 +310,13 @@
/* GC_copyThread (s, t) returns a copy of the thread pointed to by t.
*/
-pointer GC_copyThread (GC_state s, GC_thread t);
+pointer GC_copyThread (GC_state s, pointer t);
-/* GC_copyThread (s) returns a copy of the current thread, s->currentThread.
+/* GC_copyThread (s) stores a copy of the current thread, s->currentThread
+ * in s->savedThread. See the comment in basis-library/misc/primitive.sml for
+ * why it's a bad idea to have copyCurrentThread return the copy directly.
*/
-pointer GC_copyCurrentThread (GC_state s);
+void GC_copyCurrentThread (GC_state s);
/* GC_createStrings allocates a collection of strings in the heap.
* It assumes that there is enough space.
@@ -406,11 +407,6 @@
and slot < s->stackBottom + s->currentThread->stack->reserved;
}
-void GC_loadWorld (GC_state s,
- char *fileName,
- void (*loadGlobals)(FILE *file));
-
-
/*
* Build the header for an object, given the index to its type info.
*/
@@ -427,5 +423,7 @@
/* Return the amount of heap space taken by the object pointed to by root. */
uint GC_size (GC_state s, pointer root);
+
+void GC_switchToThread (GC_state s, GC_thread t);
#endif /* #ifndef _MLTON_GC_H */
1.11 +1 -1 mlton/runtime/mlton-basis.h
Index: mlton-basis.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/mlton-basis.h,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- mlton-basis.h 27 Jun 2002 17:29:27 -0000 1.10
+++ mlton-basis.h 20 Jul 2002 00:20:24 -0000 1.11
@@ -248,7 +248,7 @@
void Thread_finishHandler();
Thread Thread_saved();
void Thread_setHandler(Thread t);
-void Thread_switchTo(Thread t);
+void Thread_switchTo (Thread t, W32 ensureBytesFree);
/* ------------------------------------------------- */
/* Time */
1.5 +6 -8 mlton/runtime/basis/Thread.c
Index: Thread.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Thread.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Thread.c 19 Jul 2002 02:24:53 -0000 1.4
+++ Thread.c 20 Jul 2002 00:20:24 -0000 1.5
@@ -24,16 +24,14 @@
gcState.signalHandler = (GC_thread)t;
}
-void Thread_switchTo (Thread thread) {
- GC_thread t;
+void Thread_switchTo (Thread thread, W32 ensureBytesFree) {
GC_state s;
- t = (GC_thread)thread;
+ if (FALSE)
+ fprintf (stderr, "Thread_switchTo (0x%08x, %u)\n",
+ (uint)thread, (uint)ensureBytesFree);
s = &gcState;
s->currentThread->stack->used = s->stackTop - s->stackBottom;
- s->currentThread = t;
- s->stackBottom = ((pointer)t->stack) + sizeof(struct GC_stack);
- s->stackTop = s->stackBottom + t->stack->used;
- s->stackLimit =
- s->stackBottom + t->stack->reserved - 2 * s->maxFrameSize;
+ s->currentThread->bytesNeeded = ensureBytesFree;
+ GC_switchToThread (s, (GC_thread)thread);
}
-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel