From 1f071feed7d72dd0badf88412b5e9adb885d0aa5 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 29 Jul 2007 21:52:13 +0000 Subject: [PATCH] Remove System.Posix.Signals (moving to unix) --- System/Posix/Signals.hs | 537 ----------------------------------------------- base.cabal | 1 - 2 files changed, 538 deletions(-) delete mode 100644 System/Posix/Signals.hs diff --git a/System/Posix/Signals.hs b/System/Posix/Signals.hs deleted file mode 100644 index 2af259a..0000000 --- a/System/Posix/Signals.hs +++ /dev/null @@ -1,537 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : System.Posix.Signals --- Copyright : (c) The University of Glasgow 2002 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : provisional --- Portability : non-portable (requires POSIX) --- --- POSIX signal support --- ------------------------------------------------------------------------------ - -#include "HsBaseConfig.h" - -module System.Posix.Signals ( -#ifndef mingw32_HOST_OS - -- * The Signal type - Signal, - - -- * Specific signals - nullSignal, - internalAbort, sigABRT, - realTimeAlarm, sigALRM, - busError, sigBUS, - processStatusChanged, sigCHLD, - continueProcess, sigCONT, - floatingPointException, sigFPE, - lostConnection, sigHUP, - illegalInstruction, sigILL, - keyboardSignal, sigINT, - killProcess, sigKILL, - openEndedPipe, sigPIPE, - keyboardTermination, sigQUIT, - segmentationViolation, sigSEGV, - softwareStop, sigSTOP, - softwareTermination, sigTERM, - keyboardStop, sigTSTP, - backgroundRead, sigTTIN, - backgroundWrite, sigTTOU, - userDefinedSignal1, sigUSR1, - userDefinedSignal2, sigUSR2, -#if CONST_SIGPOLL != -1 - pollableEvent, sigPOLL, -#endif - profilingTimerExpired, sigPROF, - badSystemCall, sigSYS, - breakpointTrap, sigTRAP, - urgentDataAvailable, sigURG, - virtualTimerExpired, sigVTALRM, - cpuTimeLimitExceeded, sigXCPU, - fileSizeLimitExceeded, sigXFSZ, - - -- * Sending signals - raiseSignal, - signalProcess, - signalProcessGroup, - -#ifdef __GLASGOW_HASKELL__ - -- * Handling signals - Handler(..), - installHandler, -#endif - - -- * Signal sets - SignalSet, - emptySignalSet, fullSignalSet, - addSignal, deleteSignal, inSignalSet, - - -- * The process signal mask - getSignalMask, setSignalMask, blockSignals, unblockSignals, - - -- * The alarm timer - scheduleAlarm, - - -- * Waiting for signals - getPendingSignals, -#ifndef cygwin32_HOST_OS - awaitSignal, -#endif - -#ifdef __GLASGOW_HASKELL__ - -- * The @NOCLDSTOP@ flag - setStoppedChildFlag, queryStoppedChildFlag, -#endif - - -- MISSING FUNCTIONALITY: - -- sigaction(), (inc. the sigaction structure + flags etc.) - -- the siginfo structure - -- sigaltstack() - -- sighold, sigignore, sigpause, sigrelse, sigset - -- siginterrupt -#endif - ) where - -import Prelude -- necessary to get dependencies right - -import Foreign -import Foreign.C -import System.IO.Unsafe -import System.Posix.Types -import System.Posix.Internals - -#ifndef mingw32_HOST_OS --- WHOLE FILE... - -#ifdef __GLASGOW_HASKELL__ -#include "Signals.h" -import GHC.Conc ( ensureIOManagerIsRunning ) -#endif - --- ----------------------------------------------------------------------------- --- Specific signals - -type Signal = CInt - -nullSignal :: Signal -nullSignal = 0 - -sigABRT :: CInt -sigABRT = CONST_SIGABRT -sigALRM :: CInt -sigALRM = CONST_SIGALRM -sigBUS :: CInt -sigBUS = CONST_SIGBUS -sigCHLD :: CInt -sigCHLD = CONST_SIGCHLD -sigCONT :: CInt -sigCONT = CONST_SIGCONT -sigFPE :: CInt -sigFPE = CONST_SIGFPE -sigHUP :: CInt -sigHUP = CONST_SIGHUP -sigILL :: CInt -sigILL = CONST_SIGILL -sigINT :: CInt -sigINT = CONST_SIGINT -sigKILL :: CInt -sigKILL = CONST_SIGKILL -sigPIPE :: CInt -sigPIPE = CONST_SIGPIPE -sigQUIT :: CInt -sigQUIT = CONST_SIGQUIT -sigSEGV :: CInt -sigSEGV = CONST_SIGSEGV -sigSTOP :: CInt -sigSTOP = CONST_SIGSTOP -sigTERM :: CInt -sigTERM = CONST_SIGTERM -sigTSTP :: CInt -sigTSTP = CONST_SIGTSTP -sigTTIN :: CInt -sigTTIN = CONST_SIGTTIN -sigTTOU :: CInt -sigTTOU = CONST_SIGTTOU -sigUSR1 :: CInt -sigUSR1 = CONST_SIGUSR1 -sigUSR2 :: CInt -sigUSR2 = CONST_SIGUSR2 -sigPOLL :: CInt -sigPOLL = CONST_SIGPOLL -sigPROF :: CInt -sigPROF = CONST_SIGPROF -sigSYS :: CInt -sigSYS = CONST_SIGSYS -sigTRAP :: CInt -sigTRAP = CONST_SIGTRAP -sigURG :: CInt -sigURG = CONST_SIGURG -sigVTALRM :: CInt -sigVTALRM = CONST_SIGVTALRM -sigXCPU :: CInt -sigXCPU = CONST_SIGXCPU -sigXFSZ :: CInt -sigXFSZ = CONST_SIGXFSZ - -internalAbort ::Signal -internalAbort = sigABRT - -realTimeAlarm :: Signal -realTimeAlarm = sigALRM - -busError :: Signal -busError = sigBUS - -processStatusChanged :: Signal -processStatusChanged = sigCHLD - -continueProcess :: Signal -continueProcess = sigCONT - -floatingPointException :: Signal -floatingPointException = sigFPE - -lostConnection :: Signal -lostConnection = sigHUP - -illegalInstruction :: Signal -illegalInstruction = sigILL - -keyboardSignal :: Signal -keyboardSignal = sigINT - -killProcess :: Signal -killProcess = sigKILL - -openEndedPipe :: Signal -openEndedPipe = sigPIPE - -keyboardTermination :: Signal -keyboardTermination = sigQUIT - -segmentationViolation :: Signal -segmentationViolation = sigSEGV - -softwareStop :: Signal -softwareStop = sigSTOP - -softwareTermination :: Signal -softwareTermination = sigTERM - -keyboardStop :: Signal -keyboardStop = sigTSTP - -backgroundRead :: Signal -backgroundRead = sigTTIN - -backgroundWrite :: Signal -backgroundWrite = sigTTOU - -userDefinedSignal1 :: Signal -userDefinedSignal1 = sigUSR1 - -userDefinedSignal2 :: Signal -userDefinedSignal2 = sigUSR2 - -#if CONST_SIGPOLL != -1 -pollableEvent :: Signal -pollableEvent = sigPOLL -#endif - -profilingTimerExpired :: Signal -profilingTimerExpired = sigPROF - -badSystemCall :: Signal -badSystemCall = sigSYS - -breakpointTrap :: Signal -breakpointTrap = sigTRAP - -urgentDataAvailable :: Signal -urgentDataAvailable = sigURG - -virtualTimerExpired :: Signal -virtualTimerExpired = sigVTALRM - -cpuTimeLimitExceeded :: Signal -cpuTimeLimitExceeded = sigXCPU - -fileSizeLimitExceeded :: Signal -fileSizeLimitExceeded = sigXFSZ - --- ----------------------------------------------------------------------------- --- Signal-related functions - --- | @signalProcess int pid@ calls @kill@ to signal process @pid@ --- with interrupt signal @int@. -signalProcess :: Signal -> ProcessID -> IO () -signalProcess sig pid - = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig) - -foreign import ccall unsafe "kill" - c_kill :: CPid -> CInt -> IO CInt - - --- | @signalProcessGroup int pgid@ calls @kill@ to signal --- all processes in group @pgid@ with interrupt signal @int@. -signalProcessGroup :: Signal -> ProcessGroupID -> IO () -signalProcessGroup sig pgid - = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig) - -foreign import ccall unsafe "killpg" - c_killpg :: CPid -> CInt -> IO CInt - --- | @raiseSignal int@ calls @kill@ to signal the current process --- with interrupt signal @int@. -raiseSignal :: Signal -> IO () -raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig) - -#if defined(__GLASGOW_HASKELL__) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS)) -foreign import ccall unsafe "genericRaise" - c_raise :: CInt -> IO CInt -#else -foreign import ccall unsafe "raise" - c_raise :: CInt -> IO CInt -#endif - -#ifdef __GLASGOW_HASKELL__ -data Handler = Default - | Ignore - -- not yet: | Hold - | Catch (IO ()) - | CatchOnce (IO ()) - --- | @installHandler int handler iset@ calls @sigaction@ to install an --- interrupt handler for signal @int@. If @handler@ is @Default@, --- @SIG_DFL@ is installed; if @handler@ is @Ignore@, @SIG_IGN@ is --- installed; if @handler@ is @Catch action@, a handler is installed --- which will invoke @action@ in a new thread when (or shortly after) the --- signal is received. --- If @iset@ is @Just s@, then the @sa_mask@ of the @sigaction@ structure --- is set to @s@; otherwise it is cleared. The previously installed --- signal handler for @int@ is returned -installHandler :: Signal - -> Handler - -> Maybe SignalSet -- ^ other signals to block - -> IO Handler -- ^ old handler - -#ifdef __PARALLEL_HASKELL__ -installHandler = - error "installHandler: not available for Parallel Haskell" -#else - -installHandler int handler maybe_mask = do - ensureIOManagerIsRunning -- for the threaded RTS - case maybe_mask of - Nothing -> install' nullPtr - Just (SignalSet x) -> withForeignPtr x $ install' - where - install' mask = - alloca $ \p_sp -> do - - rc <- case handler of - Default -> stg_sig_install int STG_SIG_DFL p_sp mask - Ignore -> stg_sig_install int STG_SIG_IGN p_sp mask - Catch m -> hinstall m p_sp mask int STG_SIG_HAN - CatchOnce m -> hinstall m p_sp mask int STG_SIG_RST - - case rc of - STG_SIG_DFL -> return Default - STG_SIG_IGN -> return Ignore - STG_SIG_ERR -> throwErrno "installHandler" - STG_SIG_HAN -> do - m <- peekHandler p_sp - return (Catch m) - STG_SIG_RST -> do - m <- peekHandler p_sp - return (CatchOnce m) - _other -> - error "internal error: System.Posix.Signals.installHandler" - - hinstall 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 -- sig no. - -> CInt -- action code (STG_SIG_HAN etc.) - -> Ptr (StablePtr (IO ())) -- (in, out) Haskell handler - -> Ptr CSigset -- (in, out) blocked - -> IO CInt -- (ret) action code - -#endif /* !__PARALLEL_HASKELL__ */ -#endif /* __GLASGOW_HASKELL__ */ - --- ----------------------------------------------------------------------------- --- Alarms - --- | @scheduleAlarm i@ calls @alarm@ to schedule a real time --- alarm at least @i@ seconds in the future. -scheduleAlarm :: Int -> IO Int -scheduleAlarm secs = do - r <- c_alarm (fromIntegral secs) - return (fromIntegral r) - -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 $ fromEnum (not b) - return (rc == (0::Int)) - --- | 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 - -newtype SignalSet = SignalSet (ForeignPtr CSigset) - -emptySignalSet :: SignalSet -emptySignalSet = unsafePerformIO $ do - fp <- mallocForeignPtrBytes sizeof_sigset_t - throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset) - return (SignalSet fp) - -fullSignalSet :: SignalSet -fullSignalSet = unsafePerformIO $ do - fp <- mallocForeignPtrBytes sizeof_sigset_t - throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset) - return (SignalSet fp) - -infixr `addSignal`, `deleteSignal` -addSignal :: Signal -> SignalSet -> SignalSet -addSignal sig (SignalSet fp1) = unsafePerformIO $ do - fp2 <- mallocForeignPtrBytes sizeof_sigset_t - withForeignPtr fp1 $ \p1 -> - withForeignPtr fp2 $ \p2 -> do - copyBytes p2 p1 sizeof_sigset_t - throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig) - return (SignalSet fp2) - -deleteSignal :: Signal -> SignalSet -> SignalSet -deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do - fp2 <- mallocForeignPtrBytes sizeof_sigset_t - withForeignPtr fp1 $ \p1 -> - withForeignPtr fp2 $ \p2 -> do - copyBytes p2 p1 sizeof_sigset_t - throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig) - return (SignalSet fp2) - -inSignalSet :: Signal -> SignalSet -> Bool -inSignalSet sig (SignalSet fp) = unsafePerformIO $ - withForeignPtr fp $ \p -> do - r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig) - return (r /= 0) - --- | @getSignalMask@ calls @sigprocmask@ to determine the --- set of interrupts which are currently being blocked. -getSignalMask :: IO SignalSet -getSignalMask = do - fp <- mallocForeignPtrBytes sizeof_sigset_t - withForeignPtr fp $ \p -> - throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p) - return (SignalSet fp) - -sigProcMask :: String -> CInt -> SignalSet -> IO () -sigProcMask fn how (SignalSet set) = - withForeignPtr set $ \p_set -> - throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr) - --- | @setSignalMask mask@ calls @sigprocmask@ with --- @SIG_SETMASK@ to block all interrupts in @mask@. -setSignalMask :: SignalSet -> IO () -setSignalMask set = sigProcMask "setSignalMask" (CONST_SIG_SETMASK :: CInt) set - --- | @blockSignals mask@ calls @sigprocmask@ with --- @SIG_BLOCK@ to add all interrupts in @mask@ to the --- set of blocked interrupts. -blockSignals :: SignalSet -> IO () -blockSignals set = sigProcMask "blockSignals" (CONST_SIG_BLOCK :: CInt) set - --- | @unblockSignals mask@ calls @sigprocmask@ with --- @SIG_UNBLOCK@ to remove all interrupts in @mask@ from the --- set of blocked interrupts. -unblockSignals :: SignalSet -> IO () -unblockSignals set = sigProcMask "unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set - --- | @getPendingSignals@ calls @sigpending@ to obtain --- the set of interrupts which have been received but are currently blocked. -getPendingSignals :: IO SignalSet -getPendingSignals = do - fp <- mallocForeignPtrBytes sizeof_sigset_t - withForeignPtr fp $ \p -> - throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p) - return (SignalSet fp) - -#ifndef cygwin32_HOST_OS - --- | @awaitSignal iset@ suspends execution until an interrupt is received. --- If @iset@ is @Just s@, @awaitSignal@ calls @sigsuspend@, installing --- @s@ as the new signal mask before suspending execution; otherwise, it --- calls @pause@. @awaitSignal@ returns on receipt of a signal. If you --- have installed any signal handlers with @installHandler@, it may be --- wise to call @yield@ directly after @awaitSignal@ to ensure that the --- signal handler runs as promptly as possible. -awaitSignal :: Maybe SignalSet -> IO () -awaitSignal maybe_sigset = do - fp <- case maybe_sigset of - Nothing -> do SignalSet fp <- getSignalMask; return fp - Just (SignalSet fp) -> return fp - withForeignPtr fp $ \p -> do - c_sigsuspend p - return () - -- ignore the return value; according to the docs it can only ever be - -- (-1) with errno set to EINTR. - -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 - -foreign import ccall unsafe "__hscore_sigfillset" - c_sigfillset :: Ptr CSigset -> IO CInt - -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 - -#endif /* mingw32_HOST_OS */ - diff --git a/base.cabal b/base.cabal index c918a4f..a9148dd 100644 --- a/base.cabal +++ b/base.cabal @@ -160,7 +160,6 @@ Library { System.Mem.StableName, System.Mem.Weak, System.Posix.Internals, - System.Posix.Signals, System.Posix.Types, Text.ParserCombinators.ReadP, Text.ParserCombinators.ReadPrec, -- 1.7.10.4