[project @ 2003-04-11 10:11:24 by ross]
[haskell-directory.git] / System / Posix / Signals.hsc
index 8866bf5..edc4046 100644 (file)
@@ -90,7 +90,7 @@ import Foreign
 import Foreign.C
 import System.IO.Unsafe
 import System.Posix.Types
-import GHC.Posix
+import System.Posix.Internals
 
 #ifndef mingw32_TARGET_OS
 -- WHOLE FILE...
@@ -249,6 +249,7 @@ data Handler = Default
              | Ignore
             -- not yet: | Hold 
              | Catch (IO ())
+             | CatchOnce (IO ())
 
 installHandler :: Signal
                -> Handler
@@ -271,18 +272,28 @@ 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
        (#const STG_SIG_IGN) -> return Ignore
        (#const STG_SIG_ERR) -> throwErrno "installHandler"
        (#const STG_SIG_HAN) -> do
-               osptr <- peek p_sp
-               m     <- deRefStablePtr osptr
+               m <- peekHandler p_sp
                return (Catch m)
+       (#const STG_SIG_RST) -> do
+               m <- peekHandler p_sp
+               return (CatchOnce m)
+
+    install'' m p_sp mask int reset = do
+      sptr <- newStablePtr m
+      poke p_sp sptr
+      stg_sig_install int reset p_sp mask
+
+    peekHandler p_sp = do
+      osptr <- peek p_sp
+      deRefStablePtr osptr
 
 foreign import ccall unsafe
   stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset