aboutsummaryrefslogtreecommitdiffhomepage
path: root/System/Posix/Process/Internals.hs
diff options
context:
space:
mode:
authorGravatar Simon Marlow <marlowsd@gmail.com>2009-02-19 10:05:32 +0000
committerGravatar Simon Marlow <marlowsd@gmail.com>2009-02-19 10:05:32 +0000
commit1c4608e3b8737dbb9204f850af4d680ccea7d8ec (patch)
tree4b0a197cbf665b4f15f5c29b399edb5b16481c11 /System/Posix/Process/Internals.hs
parentcfd7c9a5bdcc7f7c414b408d19c8a39a2917eec8 (diff)
Rewrite of signal-handling.
The API is the same (for now). The new implementation has the capability to define signal handlers that have access to the siginfo of the signal (#592), but this functionality is not exposed in this patch. #2451 is the ticket for the new API. The main purpose of bringing this in now is to fix race conditions in the old signal handling code (#2858). Later we can enable the new API in the HEAD. Implementation differences: - More of the signal-handling is moved into Haskell. We store the table of signal handlers in an MVar, rather than having a table of StablePtrs in the RTS. - In the threaded RTS, the siginfo of the signal is passed down the pipe to the IO manager thread, which manages the business of starting up new signal handler threads. In the non-threaded RTS, the siginfo of caught signals is stored in the RTS, and the scheduler starts new signal handler threads.
Diffstat (limited to 'System/Posix/Process/Internals.hs')
-rw-r--r--System/Posix/Process/Internals.hs55
1 files changed, 54 insertions, 1 deletions
diff --git a/System/Posix/Process/Internals.hs b/System/Posix/Process/Internals.hs
index 8639819..deb1992 100644
--- a/System/Posix/Process/Internals.hs
+++ b/System/Posix/Process/Internals.hs
@@ -1,8 +1,20 @@
-module System.Posix.Process.Internals (pPrPr_disableITimers, c_execvpe) where
+module System.Posix.Process.Internals (
+ pPrPr_disableITimers, c_execvpe,
+ decipherWaitStatus, ProcessStatus(..) ) where
import Foreign
import Foreign.C
+import System.Exit
+import System.IO.Error
+import GHC.Conc (Signal)
+
+-- we had to move this into GHC.Conc in GHC to avoid recursive dependencies.
+-- it can be moved back when the signal handling stuff in base is moved out.
+data ProcessStatus = Exited ExitCode
+ | Terminated Signal
+ | Stopped Signal
+ deriving (Eq, Ord, Show)
-- this function disables the itimer, which would otherwise cause confusing
-- signals to be sent to the new process.
@@ -11,3 +23,44 @@ foreign import ccall unsafe "pPrPr_disableITimers"
foreign import ccall unsafe "execvpe"
c_execvpe :: CString -> Ptr CString -> Ptr CString -> IO CInt
+
+decipherWaitStatus :: CInt -> IO ProcessStatus
+decipherWaitStatus wstat =
+ if c_WIFEXITED wstat /= 0
+ then do
+ let exitstatus = c_WEXITSTATUS wstat
+ if exitstatus == 0
+ then return (Exited ExitSuccess)
+ else return (Exited (ExitFailure (fromIntegral exitstatus)))
+ else do
+ if c_WIFSIGNALED wstat /= 0
+ then do
+ let termsig = c_WTERMSIG wstat
+ return (Terminated (fromIntegral termsig))
+ else do
+ if c_WIFSTOPPED wstat /= 0
+ then do
+ let stopsig = c_WSTOPSIG wstat
+ return (Stopped (fromIntegral stopsig))
+ else do
+ ioError (mkIOError illegalOperationErrorType
+ "waitStatus" Nothing Nothing)
+
+foreign import ccall unsafe "__hsunix_wifexited"
+ c_WIFEXITED :: CInt -> CInt
+
+foreign import ccall unsafe "__hsunix_wexitstatus"
+ c_WEXITSTATUS :: CInt -> CInt
+
+foreign import ccall unsafe "__hsunix_wifsignaled"
+ c_WIFSIGNALED :: CInt -> CInt
+
+foreign import ccall unsafe "__hsunix_wtermsig"
+ c_WTERMSIG :: CInt -> CInt
+
+foreign import ccall unsafe "__hsunix_wifstopped"
+ c_WIFSTOPPED :: CInt -> CInt
+
+foreign import ccall unsafe "__hsunix_wstopsig"
+ c_WSTOPSIG :: CInt -> CInt
+