[project @ 2003-04-11 10:11:24 by ross]

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

diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc
index 6be1644..edc4046 100644 (file)
--- a/System/Posix/Signals.hsc
+++ b/System/Posix/Signals.hsc
@@ -12,7 +12,10 @@
 --
 -----------------------------------------------------------------------------
 
+#include "config.h"
+
 module System.Posix.Signals (
+#ifndef mingw32_TARGET_OS
   -- * The Signal type
   Signal,
 
@@ -38,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,
@@ -76,7 +81,7 @@ module System.Posix.Signals (
   -- sigaltstack()
   -- sighold, sigignore, sigpause, sigrelse, sigset
   -- siginterrupt
-
+#endif
   ) where
 
 #include "Signals.h"
@@ -85,7 +90,10 @@ 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...
 
 -- -----------------------------------------------------------------------------
 -- Specific signals
@@ -115,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
@@ -186,8 +196,10 @@ userDefinedSignal1 = sigUSR1
 userDefinedSignal2 :: Signal
 userDefinedSignal2 = sigUSR2
 
+#if HAVE_SIGPOLL
 pollableEvent :: Signal
 pollableEvent = sigPOLL
+#endif
 
 profilingTimerExpired :: Signal
 profilingTimerExpired = sigPROF
@@ -237,6 +249,7 @@ data Handler = Default
              | Ignore
             -- not yet: | Hold 
              | Catch (IO ())
+             | CatchOnce (IO ())
 
 installHandler :: Signal
                -> Handler
@@ -259,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
@@ -390,3 +413,6 @@ foreign import ccall unsafe "sigpending"
 foreign import ccall unsafe "__hsposix_SIG_BLOCK"   c_SIG_BLOCK   :: CInt
 foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
 foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
+
+#endif /* mingw32_TARGET_OS */
+