From: stolz <unknown>
Date: Thu, 5 Dec 2002 14:20:56 +0000 (+0000)
Subject: [project @ 2002-12-05 14:20:56 by stolz]
X-Git-Tag: nhc98-1-18-release~790
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=da44cf1d4b1e2e878f232138495d60342113e3e6;p=haskell-directory.git

[project @ 2002-12-05 14:20:56 by stolz]
Add SA_RESETHAND (aka SA_ONESHOT) support.
Requested by: John Meacham

> module Main where

> import System.Posix.Signals

> main = do
>   installHandler sigUSR1 (Catch (print "usr1")) Nothing
>   installHandler sigUSR2 (CatchOnce (print "usr2")) Nothing
>   _ <- getLine
>   return ()
---

diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc
index 8866bf5..8c44c2c 100644
--- a/System/Posix/Signals.hsc
+++ b/System/Posix/Signals.hsc
@@ -249,6 +249,7 @@ data Handler = Default
              | Ignore
 	     -- not yet: | Hold 
              | Catch (IO ())
+             | CatchOnce (IO ())
 
 installHandler :: Signal
                -> Handler
@@ -271,9 +272,8 @@ installHandler int handler maybe_mask = do
       rc <- case handler of
       	      Default -> stg_sig_install int (#const STG_SIG_DFL) p_sp mask
       	      Ignore  -> stg_sig_install int (#const STG_SIG_IGN) p_sp mask
-      	      Catch m -> do sptr <- newStablePtr m
-			    poke p_sp sptr
-			    stg_sig_install int (#const STG_SIG_HAN) p_sp mask 
+      	      Catch m -> install'' m p_sp mask int (#const STG_SIG_HAN)
+      	      CatchOnce m -> install'' m p_sp mask int (#const STG_SIG_RST)
 
       case rc of
 	(#const STG_SIG_DFL) -> return Default
@@ -284,6 +284,11 @@ installHandler int handler maybe_mask = do
         	m     <- deRefStablePtr osptr
 		return (Catch m)
 
+    install'' m p_sp mask int reset = do
+      sptr <- newStablePtr m
+      poke p_sp sptr
+      stg_sig_install int reset p_sp mask
+
 foreign import ccall unsafe
   stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
 	 -> IO CInt