projects / ghc-base.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2003-10-17 16:48:43 by ross]
[ghc-base.git] / System / Posix / Signals.hsc
diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc
index b55d2f4..f8bcb1a 100644 (file)
--- a/System/Posix/Signals.hsc
+++ b/System/Posix/Signals.hsc
@@ -57,9 +57,11 @@ module System.Posix.Signals (
   signalProcess,
   signalProcessGroup,
 
+#ifdef __GLASGOW_HASKELL__
   -- * Handling signals
   Handler(..),
   installHandler,
+#endif
 
   -- * Signal sets
   SignalSet,
@@ -75,6 +77,11 @@ module System.Posix.Signals (
   -- * Waiting for signals
   getPendingSignals, awaitSignal,
 
+#ifdef __GLASGOW_HASKELL__
+  -- * The @NOCLDSTOP@ flag
+  setStoppedChildFlag, queryStoppedChildFlag,
+#endif
+
   -- MISSING FUNCTIONALITY:
   -- sigaction(), (inc. the sigaction structure + flags etc.)
   -- the siginfo structure
@@ -84,13 +91,17 @@ module System.Posix.Signals (
 #endif
   ) where
 
+#ifdef __GLASGOW_HASKELL__
 #include "Signals.h"
+#else
+#include "HsBase.h"
+#endif
 
 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...
@@ -103,36 +114,69 @@ type Signal = CInt
 nullSignal :: Signal
 nullSignal = 0
 
-foreign import ccall "__hsposix_SIGABRT"   sigABRT   :: CInt
-foreign import ccall "__hsposix_SIGALRM"   sigALRM   :: CInt
-foreign import ccall "__hsposix_SIGBUS"    sigBUS    :: CInt
-foreign import ccall "__hsposix_SIGCHLD"   sigCHLD   :: CInt
-foreign import ccall "__hsposix_SIGCONT"   sigCONT   :: CInt
-foreign import ccall "__hsposix_SIGFPE"    sigFPE    :: CInt
-foreign import ccall "__hsposix_SIGHUP"    sigHUP    :: CInt
-foreign import ccall "__hsposix_SIGILL"    sigILL    :: CInt
-foreign import ccall "__hsposix_SIGINT"    sigINT    :: CInt
-foreign import ccall "__hsposix_SIGKILL"   sigKILL   :: CInt
-foreign import ccall "__hsposix_SIGPIPE"   sigPIPE   :: CInt
-foreign import ccall "__hsposix_SIGQUIT"   sigQUIT   :: CInt
-foreign import ccall "__hsposix_SIGSEGV"   sigSEGV   :: CInt
-foreign import ccall "__hsposix_SIGSTOP"   sigSTOP   :: CInt
-foreign import ccall "__hsposix_SIGTERM"   sigTERM   :: CInt
-foreign import ccall "__hsposix_SIGTSTP"   sigTSTP   :: CInt
-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
+#ifdef __HUGS__
+sigABRT   = (#const SIGABRT)   :: CInt
+sigALRM   = (#const SIGALRM)   :: CInt
+sigBUS    = (#const SIGBUS)    :: CInt
+sigCHLD   = (#const SIGCHLD)   :: CInt
+sigCONT   = (#const SIGCONT)   :: CInt
+sigFPE    = (#const SIGFPE)    :: CInt
+sigHUP    = (#const SIGHUP)    :: CInt
+sigILL    = (#const SIGILL)    :: CInt
+sigINT    = (#const SIGINT)    :: CInt
+sigKILL   = (#const SIGKILL)   :: CInt
+sigPIPE   = (#const SIGPIPE)   :: CInt
+sigQUIT   = (#const SIGQUIT)   :: CInt
+sigSEGV   = (#const SIGSEGV)   :: CInt
+sigSTOP   = (#const SIGSTOP)   :: CInt
+sigTERM   = (#const SIGTERM)   :: CInt
+sigTSTP   = (#const SIGTSTP)   :: CInt
+sigTTIN   = (#const SIGTTIN)   :: CInt
+sigTTOU   = (#const SIGTTOU)   :: CInt
+sigUSR1   = (#const SIGUSR1)   :: CInt
+sigUSR2   = (#const SIGUSR2)   :: CInt
 #if HAVE_SIGPOLL
-foreign import ccall "__hsposix_SIGPOLL"   sigPOLL   :: CInt
+sigPOLL   = (#const SIGPOLL)   :: CInt
 #endif
-foreign import ccall "__hsposix_SIGPROF"   sigPROF   :: CInt
-foreign import ccall "__hsposix_SIGSYS"    sigSYS    :: CInt
-foreign import ccall "__hsposix_SIGTRAP"   sigTRAP   :: CInt
-foreign import ccall "__hsposix_SIGURG"    sigURG    :: CInt
-foreign import ccall "__hsposix_SIGVTALRM" sigVTALRM :: CInt
-foreign import ccall "__hsposix_SIGXCPU"   sigXCPU   :: CInt
-foreign import ccall "__hsposix_SIGXFSZ"   sigXFSZ   :: CInt
+sigPROF   = (#const SIGPROF)   :: CInt
+sigSYS    = (#const SIGSYS)    :: CInt
+sigTRAP   = (#const SIGTRAP)   :: CInt
+sigURG    = (#const SIGURG)    :: CInt
+sigVTALRM = (#const SIGVTALRM) :: CInt
+sigXCPU   = (#const SIGXCPU)   :: CInt
+sigXFSZ   = (#const SIGXFSZ)   :: CInt
+#else
+foreign import ccall unsafe "__hsposix_SIGABRT"   sigABRT   :: CInt
+foreign import ccall unsafe "__hsposix_SIGALRM"   sigALRM   :: CInt
+foreign import ccall unsafe "__hsposix_SIGBUS"    sigBUS    :: CInt
+foreign import ccall unsafe "__hsposix_SIGCHLD"   sigCHLD   :: CInt
+foreign import ccall unsafe "__hsposix_SIGCONT"   sigCONT   :: CInt
+foreign import ccall unsafe "__hsposix_SIGFPE"    sigFPE    :: CInt
+foreign import ccall unsafe "__hsposix_SIGHUP"    sigHUP    :: CInt
+foreign import ccall unsafe "__hsposix_SIGILL"    sigILL    :: CInt
+foreign import ccall unsafe "__hsposix_SIGINT"    sigINT    :: CInt
+foreign import ccall unsafe "__hsposix_SIGKILL"   sigKILL   :: CInt
+foreign import ccall unsafe "__hsposix_SIGPIPE"   sigPIPE   :: CInt
+foreign import ccall unsafe "__hsposix_SIGQUIT"   sigQUIT   :: CInt
+foreign import ccall unsafe "__hsposix_SIGSEGV"   sigSEGV   :: CInt
+foreign import ccall unsafe "__hsposix_SIGSTOP"   sigSTOP   :: CInt
+foreign import ccall unsafe "__hsposix_SIGTERM"   sigTERM   :: CInt
+foreign import ccall unsafe "__hsposix_SIGTSTP"   sigTSTP   :: CInt
+foreign import ccall unsafe "__hsposix_SIGTTIN"   sigTTIN   :: CInt
+foreign import ccall unsafe "__hsposix_SIGTTOU"   sigTTOU   :: CInt
+foreign import ccall unsafe "__hsposix_SIGUSR1"   sigUSR1   :: CInt
+foreign import ccall unsafe "__hsposix_SIGUSR2"   sigUSR2   :: CInt
+#if HAVE_SIGPOLL
+foreign import ccall unsafe "__hsposix_SIGPOLL"   sigPOLL   :: CInt
+#endif
+foreign import ccall unsafe "__hsposix_SIGPROF"   sigPROF   :: CInt
+foreign import ccall unsafe "__hsposix_SIGSYS"    sigSYS    :: CInt
+foreign import ccall unsafe "__hsposix_SIGTRAP"   sigTRAP   :: CInt
+foreign import ccall unsafe "__hsposix_SIGURG"    sigURG    :: CInt
+foreign import ccall unsafe "__hsposix_SIGVTALRM" sigVTALRM :: CInt
+foreign import ccall unsafe "__hsposix_SIGXCPU"   sigXCPU   :: CInt
+foreign import ccall unsafe "__hsposix_SIGXFSZ"   sigXFSZ   :: CInt
+#endif /* __HUGS__ */
 
 internalAbort ::Signal
 internalAbort = sigABRT
@@ -245,6 +289,7 @@ raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
 foreign import ccall unsafe "raise"
   c_raise :: CInt -> IO CInt
 
+#ifdef __GLASGOW_HASKELL__
 data Handler = Default
              | Ignore
             -- not yet: | Hold 
@@ -299,7 +344,8 @@ foreign import ccall unsafe
   stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
         -> IO CInt
 
-#endif // !__PARALLEL_HASKELL__
+#endif /* !__PARALLEL_HASKELL__ */
+#endif /* __GLASGOW_HASKELL__ */
 
 -- -----------------------------------------------------------------------------
 -- Alarms
@@ -312,6 +358,29 @@ scheduleAlarm secs = do
 foreign import ccall unsafe "alarm"
   c_alarm :: CUInt -> IO CUInt
 
+#ifdef __GLASGOW_HASKELL__
+-- -----------------------------------------------------------------------------
+-- The NOCLDSTOP flag
+
+foreign import ccall "&nocldstop" nocldstop :: Ptr Int
+
+-- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
+-- installing new signal handlers.
+setStoppedChildFlag :: Bool -> IO Bool
+setStoppedChildFlag b = do
+    rc <- peek nocldstop
+    poke nocldstop x
+    return (rc == (0::Int))
+  where
+    x = case b of {True -> 0; False -> 1}
+
+-- | Queries the current state of the stopped child flag.
+queryStoppedChildFlag :: IO Bool
+queryStoppedChildFlag = do
+    rc <- peek nocldstop
+    return (rc == (0::Int))
+#endif /* __GLASGOW_HASKELL__ */
+
 -- -----------------------------------------------------------------------------
 -- Manipulating signal sets
 
@@ -358,7 +427,7 @@ getSignalMask :: IO SignalSet
 getSignalMask = do
   fp <- mallocForeignPtrBytes sizeof_sigset_t
   withForeignPtr fp $ \p ->
-    throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 p nullPtr)
+    throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
   return (SignalSet fp)
    
 sigProcMask :: String -> CInt -> SignalSet -> IO ()
@@ -398,6 +467,16 @@ foreign import ccall unsafe "sigsuspend"
   c_sigsuspend :: Ptr CSigset -> IO CInt
 #endif
 
+#ifdef __HUGS__
+foreign import ccall unsafe "sigdelset"
+  c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt
+
+foreign import ccall unsafe "sigfillset"
+  c_sigfillset  :: Ptr CSigset -> IO CInt
+
+foreign import ccall unsafe "sigismember"
+  c_sigismember :: Ptr CSigset -> CInt -> IO CInt
+#else
 foreign import ccall unsafe "__hscore_sigdelset"
   c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt
 
@@ -406,13 +485,20 @@ foreign import ccall unsafe "__hscore_sigfillset"
 
 foreign import ccall unsafe "__hscore_sigismember"
   c_sigismember :: Ptr CSigset -> CInt -> IO CInt
+#endif /* __HUGS__ */
 
 foreign import ccall unsafe "sigpending"
   c_sigpending :: Ptr CSigset -> IO CInt
 
+#ifdef __HUGS__
+c_SIG_BLOCK   = (#const SIG_BLOCK)   :: CInt
+c_SIG_SETMASK = (#const SIG_SETMASK) :: CInt
+c_SIG_UNBLOCK = (#const SIG_UNBLOCK) :: CInt
+#else
 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 /* __HUGS__ */
 
 #endif /* mingw32_TARGET_OS */
 
GHC "base" library, with HetMet modifications