[project @ 2003-08-04 10:05:32 by ross]

[haskell-directory.git] / System / Posix / Signals.hsc

diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc
index f4ebb0b..edc4046 100644 (file)
--- a/System/Posix/Signals.hsc
+++ b/System/Posix/Signals.hsc
@@ -41,7 +41,9 @@ module System.Posix.Signals (
   backgroundWrite, sigTTOU,
   userDefinedSignal1, sigUSR1,
   userDefinedSignal2, sigUSR2,
+#if HAVE_SIGPOLL
   pollableEvent, sigPOLL,
+#endif
   profilingTimerExpired, sigPROF,
   badSystemCall, sigSYS,
   breakpointTrap, sigTRAP,
@@ -88,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...
@@ -121,7 +123,9 @@ foreign import ccall "__hsposix_SIGTTIN"   sigTTIN   :: CInt
 foreign import ccall "__hsposix_SIGTTOU"   sigTTOU   :: CInt
 foreign import ccall "__hsposix_SIGUSR1"   sigUSR1   :: CInt
 foreign import ccall "__hsposix_SIGUSR2"   sigUSR2   :: CInt
+#if HAVE_SIGPOLL
 foreign import ccall "__hsposix_SIGPOLL"   sigPOLL   :: CInt
+#endif
 foreign import ccall "__hsposix_SIGPROF"   sigPROF   :: CInt
 foreign import ccall "__hsposix_SIGSYS"    sigSYS    :: CInt
 foreign import ccall "__hsposix_SIGTRAP"   sigTRAP   :: CInt
@@ -192,8 +196,10 @@ userDefinedSignal1 = sigUSR1
 userDefinedSignal2 :: Signal
 userDefinedSignal2 = sigUSR2
 
+#if HAVE_SIGPOLL
 pollableEvent :: Signal
 pollableEvent = sigPOLL
+#endif
 
 profilingTimerExpired :: Signal
 profilingTimerExpired = sigPROF
@@ -243,6 +249,7 @@ data Handler = Default
              | Ignore
             -- not yet: | Hold 
              | Catch (IO ())
+             | CatchOnce (IO ())
 
 installHandler :: Signal
                -> Handler
@@ -265,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