[MLton] cvs commit: restructure of signal handling
Matthew Fluet
fluet@mlton.org
Wed, 28 Apr 2004 19:59:00 -0700
fluet 04/04/28 19:58:59
Modified: basis-library/mlton signal.sig signal.sml thread.sml
basis-library/posix primitive.sml
bin regression
runtime Makefile gc.c gc.h mlton-basis.h mlton-posix.h
runtime/Posix/Signal Signal.c
Added: runtime/Posix/Signal resetPending.c
Log:
MAIL restructure of signal handling
This checkin moves the entire process of blocking and unblocking of
signals during a signal handler to the ML side. Signals are only
blocked while extracting the set of handlers from the
gcState.pendingSignals sigset. No user code is run while signals are
blocked.
The enter/leave functions of gc.c are also modified to treat runtime
functions as running in a critical section (i.e., with canHandle++ in
enter and canHandle-- in leave); this prevents limit from being
modified while in the runtime. If a signal is caught on the C side
while in the GC, the limit will be reset to 0 during leave.
Revision Changes Path
1.14 +3 -0 mlton/basis-library/mlton/signal.sig
Index: signal.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/signal.sig,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- signal.sig 15 Apr 2004 13:02:13 -0000 1.13
+++ signal.sig 29 Apr 2004 02:58:58 -0000 1.14
@@ -3,6 +3,8 @@
type t
type signal = t
+ val sigismember : signal -> int;
+
structure Handler:
sig
type t
@@ -31,6 +33,7 @@
end
val getHandler: t -> Handler.t
+ val handlers: Handler.t array
val prof: t
val setHandler: t * Handler.t -> unit
(* suspend m temporarily sets the signal mask to m and suspends until an
1.30 +66 -57 mlton/basis-library/mlton/signal.sml
Index: signal.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/signal.sml,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- signal.sml 15 Apr 2004 13:14:54 -0000 1.29
+++ signal.sml 29 Apr 2004 02:58:58 -0000 1.30
@@ -14,12 +14,28 @@
type t = signal
+val sigismember = Prim.sigismember
+
val prof = Prim.prof
val vtalrm = Prim.vtalrm
+type how = Prim.how
+
(* val toString = SysWord.toString o toWord *)
val checkResult = Error.checkResult
+val checkReturnResult = Error.checkReturnResult
+fun raiseInval () =
+ let
+ open PosixError
+ in
+ raiseSys inval
+ end
+
+val validSignals =
+ Array.tabulate
+ (Prim.numSignals, fn i =>
+ Prim.sigismember(fromInt i) <> ~1)
structure Mask =
struct
@@ -33,34 +49,19 @@
val all = allBut []
val none = some []
- local
- fun member (sigs, s) = List.exists (fn s' => s = s') sigs
- fun inter (sigs1, sigs2) =
- List.filter (fn s => member (sigs2, s)) sigs1
- fun diff (sigs1, sigs2) =
- List.filter (fn s => not (member (sigs2, s))) sigs1
- fun union (sigs1, sigs2) =
- List.foldl (fn (s,sigs) => if member (sigs, s) then sigs else s::sigs) sigs1 sigs2
- in
- fun block (mask1, mask2) =
- case (mask1, mask2) of
- (AllBut sigs1, AllBut sigs2) => AllBut (inter (sigs1, sigs2))
- | (AllBut sigs1, Some sigs2) => AllBut (diff (sigs1, sigs2))
- | (Some sigs1, AllBut sigs2) => AllBut (diff (sigs2, sigs1))
- | (Some sigs1, Some sigs2) => Some (union (sigs1, sigs2))
- fun unblock (mask1, mask2) =
- case (mask1, mask2) of
- (AllBut sigs1, AllBut sigs2) => Some (diff (sigs2, sigs1))
- | (AllBut sigs1, Some sigs2) => AllBut (union (sigs1, sigs2))
- | (Some sigs1, AllBut sigs2) => Some (inter (sigs1, sigs2))
- | (Some sigs1, Some sigs2) => Some (diff (sigs1, sigs2))
- fun isMember (mask, s) =
- case mask of
- AllBut sigs => not (member (sigs, s))
- | Some sigs => member (sigs, s)
- end
+ fun read () =
+ Some
+ (Array.foldri
+ (fn (i, b, sigs) =>
+ if b
+ then if checkReturnResult(Prim.sigismember(fromInt i)) = 1
+ then (fromInt i)::sigs
+ else sigs
+ else sigs)
+ []
+ validSignals)
- fun create m =
+ fun write m =
case m of
AllBut signals =>
(checkResult (Prim.sigfillset ())
@@ -70,17 +71,24 @@
; List.app (checkResult o Prim.sigaddset) signals)
local
- val blocked = ref none
-
- fun make (m: t) =
- (create m
- ; checkResult (Prim.sigprocmask ())
- ; blocked := m)
+ fun make (how: how) (m: t) =
+ (write m; checkResult (Prim.sigprocmask how))
in
- val block = fn m => make (block (!blocked, m))
- val unblock = fn m => make (unblock (!blocked, m))
- val setBlocked = fn m => make m
- val getBlocked = fn () => !blocked
+ val block = make Prim.block
+ val unblock = make Prim.unblock
+ val setBlocked = make Prim.setmask
+ fun getBlocked () = (make Prim.block none; read ())
+ end
+
+ local
+ fun member (sigs, s) = List.exists (fn s' => s = s') sigs
+ in
+ fun isMember (mask, s) =
+ if Array.sub (validSignals, toInt s)
+ then case mask of
+ AllBut sigs => not (member (sigs, s))
+ | Some sigs => member (sigs, s)
+ else raiseInval ()
end
end
@@ -106,13 +114,6 @@
else InvalidSignal
end
-fun raiseInval () =
- let
- open PosixError
- in
- raiseSys inval
- end
-
val (getHandler, set, handlers) =
let
val handlers = Array.tabulate (Prim.numSignals, initHandler o fromInt)
@@ -158,21 +159,29 @@
MLtonThread.setHandler
(fn t =>
let
- val t =
- Array.foldli
- (fn (s, h, t) =>
+ val mask = Mask.getBlocked ()
+ val () =
+ (Mask.block o Mask.some)
+ (Array.foldri
+ (fn (s, h, sigs) =>
+ case h of
+ Handler _ => (fromInt s)::sigs
+ | _ => sigs) [] handlers)
+ val fs =
+ case !gcHandler of
+ Handler f => if Prim.isGCPending () then [f] else []
+ | _ => []
+ val fs =
+ Array.foldri
+ (fn (s, h, fs) =>
case h of
Handler f =>
- if Prim.isPending (fromInt s) then f t else t
- | _ => t)
- t
- handlers
- val t =
- case !gcHandler of
- Handler f => if Prim.isGCPending () then f t else t
- | _ => t
+ if Prim.isPending (fromInt s) then f::fs else fs
+ | _ => fs) fs handlers
+ val () = Prim.resetPending ()
+ val () = Mask.setBlocked mask
in
- t
+ List.foldl (fn (f, t) => f t) t fs
end)
in
Handler
@@ -200,7 +209,7 @@
; checkResult (Prim.ignore s))
fun suspend m =
- (Mask.create m
+ (Mask.write m
; Prim.suspend ()
; MLtonThread.switchToHandler ())
1.25 +1 -1 mlton/basis-library/mlton/thread.sml
Index: thread.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/thread.sml,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- thread.sml 2 Apr 2004 02:49:51 -0000 1.24
+++ thread.sml 29 Apr 2004 02:58:58 -0000 1.25
@@ -224,7 +224,7 @@
val state: state ref = ref Normal
in
fun amInSignalHandler () = InHandler = !state
-
+
fun setHandler (f: unit t -> unit t): unit =
let
val _ = Primitive.installSignalHandler ()
1.27 +8 -1 mlton/basis-library/posix/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/primitive.sml,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- primitive.sml 14 Apr 2004 01:12:39 -0000 1.26
+++ primitive.sml 29 Apr 2004 02:58:58 -0000 1.27
@@ -122,12 +122,14 @@
structure Signal:>
sig
eqtype t
+ type how
val fromInt: int -> t
val toInt: t -> int
end =
struct
type t = int
+ type how = int
val fromInt = fn s => s
val toInt = fn s => s
@@ -160,6 +162,7 @@
val usr2 = _const "Posix_Signal_usr2": t;
val vtalrm = _const "Posix_Signal_vtalrm": t;
+ val block = _const "Posix_Signal_block": how;
val default = _import "Posix_Signal_default": t -> int;
val handleGC = _import "Posix_Signal_handleGC": unit -> unit;
val handlee = _import "Posix_Signal_handle": t -> int;
@@ -169,12 +172,16 @@
val isGCPending = _import "Posix_Signal_isGCPending": unit -> bool;
val isPending = _import "Posix_Signal_isPending": t -> bool;
val numSignals = _const "Posix_Signal_numSignals": int;
+ val resetPending = _import "Posix_Signal_resetPending": unit -> unit;
+ val setmask = _const "Posix_Signal_setmask": how;
val sigaddset = _import "Posix_Signal_sigaddset": t -> int;
val sigdelset = _import "Posix_Signal_sigdelset": t -> int;
val sigemptyset = _import "Posix_Signal_sigemptyset": unit -> int;
val sigfillset = _import "Posix_Signal_sigfillset": unit -> int;
- val sigprocmask = _import "Posix_Signal_sigprocmask": unit -> int;
+ val sigismember = _import "Posix_Signal_sigismember": t -> int;
+ val sigprocmask = _import "Posix_Signal_sigprocmask": how -> int;
val suspend = _import "Posix_Signal_suspend": unit -> unit;
+ val unblock = _const "Posix_Signal_unblock": how;
end
structure Process =
1.78 +2 -2 mlton/bin/regression
Index: regression
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/regression,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -r1.77 -r1.78
--- regression 27 Apr 2004 08:15:10 -0000 1.77
+++ regression 29 Apr 2004 02:58:58 -0000 1.78
@@ -59,9 +59,9 @@
if [ $cross = 'yes' ]; then
flags="$flags -target $crossTarget -stop g"
fi
-cont='callcc.sml callcc2.sml callcc3.sml'
+cont='callcc.sml callcc2.sml callcc3.sml once.sml'
intInf='conv.sml conv2.sml harmonic.sml int-inf.*.sml slow.sml slower.sml smith-normal-form.sml'
-signal='finalize.sml signals.sml signals2.sml suspend.sml'
+signal='finalize.sml signals.sml signals2.sml suspend.sml weak.sml'
thread='thread0.sml thread1.sml thread2.sml mutex.sml prodcons.sml same-fringe.sml timeout.sml'
world='world1.sml world2.sml world3.sml world4.sml world5.sml world6.sml'
tmp=/tmp/z.regression.$$
1.80 +2 -0 mlton/runtime/Makefile
Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -r1.79 -r1.80
--- Makefile 4 Apr 2004 18:21:42 -0000 1.79
+++ Makefile 29 Apr 2004 02:58:58 -0000 1.80
@@ -180,6 +180,7 @@
Posix/Process/waitpid.o \
Posix/Signal/Signal.o \
Posix/Signal/isPending.o \
+ Posix/Signal/resetPending.o \
Posix/SysDB/Group.o \
Posix/SysDB/Passwd.o \
Posix/TTY/Termios.o \
@@ -345,6 +346,7 @@
Posix/Process/waitpid-gdb.o \
Posix/Signal/Signal-gdb.o \
Posix/Signal/isPending-gdb.o \
+ Posix/Signal/resetPending-gdb.o \
Posix/SysDB/Group-gdb.o \
Posix/SysDB/Passwd-gdb.o \
Posix/TTY/Termios-gdb.o \
1.178 +21 -48 mlton/runtime/gc.c
Index: gc.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.c,v
retrieving revision 1.177
retrieving revision 1.178
diff -u -r1.177 -r1.178
--- gc.c 26 Apr 2004 01:15:12 -0000 1.177
+++ gc.c 29 Apr 2004 02:58:58 -0000 1.178
@@ -1290,37 +1290,13 @@
}
#endif /* #if ASSERT */
-/* The purpose of blocking signals in GC is to prevent GC_handler from running,
- * which would muck with s->limit. However, if the program doesn't handle
- * signals, we don't need to block them. This can be tested via the weak symbol
- * Posix_Signal_handle.
- */
-#if SUPPORTS_WEAK
-void Posix_Signal_handle () __attribute__ ((weak));
-#else
-void Posix_Signal_handle ();
-#endif
-static inline bool shouldBlockSignals () {
- return 0 != Posix_Signal_handle;
-}
-
-static inline void blockSignals (GC_state s) {
- if (shouldBlockSignals ())
- sigprocmask (SIG_BLOCK, &s->signalsHandled, NULL);
-}
-
-static inline void unblockSignals (GC_state s) {
- if (shouldBlockSignals ())
- sigprocmask (SIG_SETMASK, &s->signalsBlocked, NULL);
-}
-
/* ---------------------------------------------------------------- */
/* enter and leave */
/* ---------------------------------------------------------------- */
/* enter and leave should be called at the start and end of every GC function
- * that is exported to the outside world. They make sure that signals are
- * blocked for the duration of the function and check the GC invariant
+ * that is exported to the outside world. They make sure that the function
+ * is run in a critical section and check the GC invariant.
* They are a bit tricky because of the case when the runtime system is invoked
* from within an ML signal handler.
*/
@@ -1332,8 +1308,8 @@
s->currentThread->exnStack = s->exnStack;
if (DEBUG)
GC_display (s, stderr);
+ s->canHandle++;
unless (s->inSignalHandler) {
- blockSignals (s);
if (0 == s->limit)
s->limit = s->limitPlusSlop - LIMIT_SLOP;
}
@@ -1349,10 +1325,9 @@
* for functions that don't ensureBytesFree.
*/
assert (mutatorInvariant (s, FALSE, TRUE));
- if (s->canHandle == 0 and s->signalIsPending)
+ if (s->canHandle == 1 and s->signalIsPending)
s->limit = 0;
- unless (s->inSignalHandler)
- unblockSignals (s);
+ s->canHandle--;
if (DEBUG)
fprintf (stderr, "leave ok\n");
}
@@ -3106,16 +3081,18 @@
fprintf (stderr, "switching to signal handler\n");
GC_display (s, stderr);
}
- assert (s->canHandle == 0);
+ assert (s->canHandle == 1);
assert (s->signalIsPending);
s->signalIsPending = FALSE;
s->inSignalHandler = TRUE;
s->savedThread = s->currentThread;
- /* Set s->canHandle to 1 when switching to the signal handler thread,
- * which will then run atomically and will finish by switching to
- * the thread to continue with, which will decrement s->canHandle to 0.
+ /* Set s->canHandle to 2 when switching to the signal handler thread;
+ * leaving the runtime will decrement s->canHandle to 1,
+ * the signal handler will then run atomically and will finish by
+ * switching to the thread to continue with, which will decrement
+ * s->canHandle to 0.
*/
- s->canHandle = 1;
+ s->canHandle = 2;
}
void GC_switchToThread (GC_state s, GC_thread t, uint ensureBytesFree) {
@@ -3131,7 +3108,7 @@
s->currentThread->bytesNeeded = ensureBytesFree;
switchToThread (s, t);
s->canHandle--;
- if (s->canHandle == 0 and s->signalIsPending) {
+ if (s->canHandle == 1 and s->signalIsPending) {
startHandler (s);
switchToThread (s, s->signalHandler);
}
@@ -3143,8 +3120,8 @@
/* BEGIN: enter(s); */
s->currentThread->stack->used = currentStackUsed (s);
s->currentThread->exnStack = s->exnStack;
+ s->canHandle++;
unless (s->inSignalHandler) {
- blockSignals (s);
if (0 == s->limit)
s->limit = s->limitPlusSlop - LIMIT_SLOP;
}
@@ -3152,7 +3129,7 @@
s->currentThread->bytesNeeded = ensureBytesFree;
switchToThread (s, t);
s->canHandle--;
- if (s->canHandle == 0 and s->signalIsPending) {
+ if (s->canHandle == 1 and s->signalIsPending) {
startHandler (s);
switchToThread (s, s->signalHandler);
}
@@ -3166,8 +3143,7 @@
/* END: ensureMutatorInvariant */
else {
/* BEGIN: leave(s); */
- unless (s->inSignalHandler)
- unblockSignals (s);
+ s->canHandle--;
/* END: leave(s); */
}
}
@@ -3178,15 +3154,15 @@
/* GC_startHandler does not do an enter()/leave(), even though it is exported.
* The basis library uses it via _ffi, not _prim, and so does not treat it as a
* runtime call -- so the invariant in enter would fail miserably. It simulates
- * the relevant part of enter() by blocking signals and resetting the limit.
- * The leave() wouldn't do anything upon exit because we are in a signal
- * handler.
+ * the relevant part of enter() by incrementing s->canHandle and resetting the
+ * limit; it simulates the leave by decrementing s->canHandle.
*/
void GC_startHandler (GC_state s) {
- blockSignals (s);
+ s->canHandle++;
if (0 == s->limit)
s->limit = s->limitPlusSlop - LIMIT_SLOP;
startHandler (s);
+ s->canHandle--;
}
void GC_gc (GC_state s, uint bytesRequested, bool force,
@@ -3200,7 +3176,7 @@
if (0 == bytesRequested)
bytesRequested = LIMIT_SLOP;
s->currentThread->bytesNeeded = bytesRequested;
- if (s->canHandle == 0 and s->signalIsPending) {
+ if (s->canHandle == 1 and s->signalIsPending) {
startHandler(s);
switchToThread (s, s->signalHandler);
}
@@ -4595,9 +4571,6 @@
fprintf (stderr, "GC_finishHandler ()\n");
assert (s->canHandle == 1);
s->inSignalHandler = FALSE;
- sigemptyset (&s->signalsPending);
- s->gcSignalIsPending = FALSE;
- unblockSignals (s);
}
/* GC_handler sets s->limit = 0 so that the next limit check will fail.
1.74 +4 -0 mlton/runtime/gc.h
Index: gc.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.h,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -r1.73 -r1.74
--- gc.h 7 Apr 2004 00:47:47 -0000 1.73
+++ gc.h 29 Apr 2004 02:58:58 -0000 1.74
@@ -556,6 +556,10 @@
*/
void GC_done (GC_state s);
+/* GC_resetSignals should be called by the mutator signal handler thread when
+ * it is fetching the pending signals.
+ */
+void GC_resetSignals (GC_state s);
/* GC_finishHandler should be called by the mutator signal handler thread when
* it is done handling the signal.
1.31 +1 -0 mlton/runtime/mlton-basis.h
Index: mlton-basis.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/mlton-basis.h,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- mlton-basis.h 4 Apr 2004 18:21:43 -0000 1.30
+++ mlton-basis.h 29 Apr 2004 02:58:58 -0000 1.31
@@ -200,6 +200,7 @@
Thread Thread_current ();
void Thread_finishHandler ();
+void Thread_resetSignals ();
Thread Thread_saved ();
void Thread_setHandler (Thread t);
void Thread_startHandler ();
1.10 +1 -1 mlton/runtime/mlton-posix.h
Index: mlton-posix.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/mlton-posix.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- mlton-posix.h 14 Apr 2004 01:12:48 -0000 1.9
+++ mlton-posix.h 29 Apr 2004 02:58:58 -0000 1.10
@@ -189,7 +189,7 @@
Int Posix_Signal_sigdelset (Int signum);
Int Posix_Signal_sigemptyset ();
Int Posix_Signal_sigfillset ();
-Int Posix_Signal_sigprocmask ();
+Int Posix_Signal_sigprocmask (Int how);
Int Posix_Signal_sigsuspend ();
/* ------------------------------------------------- */
1.15 +2 -5 mlton/runtime/Posix/Signal/Signal.c
Index: Signal.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Posix/Signal/Signal.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- Signal.c 15 Apr 2004 13:02:13 -0000 1.14
+++ Signal.c 29 Apr 2004 02:58:59 -0000 1.15
@@ -89,11 +89,8 @@
return sigismember (&set, signum);
}
-Int Posix_Signal_sigprocmask () {
- gcState.signalsBlocked = set;
- if (gcState.inSignalHandler)
- return 0;
- return sigprocmask (SIG_SETMASK, &set, (sigset_t*)NULL);
+Int Posix_Signal_sigprocmask (Int how) {
+ return sigprocmask (how, &set, &set);
}
void Posix_Signal_suspend () {
1.1 mlton/runtime/Posix/Signal/resetPending.c
Index: resetPending.c
===================================================================
#include <signal.h>
#include "gc.h"
#include "mlton-posix.h"
enum {
DEBUG_SIGNALS = FALSE,
};
extern struct GC_state gcState;
bool Posix_Signal_resetPending () {
if (DEBUG_SIGNALS)
fprintf (stderr, "Posix_Signal_resetPending ()\n");
sigemptyset (&gcState.signalsPending);
gcState.gcSignalIsPending = FALSE;
}