|
1 | 1 | {-# LANGUAGE Safe #-}
|
2 | 2 | {-# LANGUAGE CApiFFI #-}
|
| 3 | +{-# LANGUAGE InterruptibleFFI #-} |
3 | 4 | -----------------------------------------------------------------------------
|
4 | 5 | -- |
|
5 | 6 | -- Module : System.Posix.Semaphore
|
|
16 | 17 |
|
17 | 18 | module System.Posix.Semaphore
|
18 | 19 | (OpenSemFlags(..), Semaphore(),
|
19 |
| - semOpen, semUnlink, semWait, semTryWait, semThreadWait, |
| 20 | + semOpen, semUnlink, semWait, semWaitInterruptible, semTryWait, semThreadWait, |
20 | 21 | semPost, semGetValue)
|
21 | 22 | where
|
22 | 23 |
|
@@ -79,6 +80,20 @@ semWait (Semaphore fptr) = withForeignPtr fptr semWait'
|
79 | 80 | where semWait' sem = throwErrnoIfMinus1Retry_ "semWait" $
|
80 | 81 | sem_wait sem
|
81 | 82 |
|
| 83 | +-- | Lock the semaphore, blocking until it becomes available. |
| 84 | +-- |
| 85 | +-- Unlike 'semWait', this wait operation can be interrupted with an |
| 86 | +-- EINTR signal. |
| 87 | +semWaitInterruptible :: Semaphore -> IO Bool |
| 88 | +semWaitInterruptible (Semaphore fptr) = withForeignPtr fptr semWait' |
| 89 | + where semWait' sem = |
| 90 | + do res <- sem_wait_interruptible sem |
| 91 | + if res == 0 then return True |
| 92 | + else do errno <- getErrno |
| 93 | + if errno == eINTR |
| 94 | + then return False |
| 95 | + else throwErrno "semWaitInterrruptible" |
| 96 | + |
82 | 97 | -- | Attempt to lock the semaphore without blocking. Immediately return
|
83 | 98 | -- False if it is not available.
|
84 | 99 | semTryWait :: Semaphore -> IO Bool
|
@@ -132,9 +147,10 @@ foreign import capi safe "semaphore.h sem_close"
|
132 | 147 | sem_close :: Ptr () -> IO CInt
|
133 | 148 | foreign import capi safe "semaphore.h sem_unlink"
|
134 | 149 | sem_unlink :: CString -> IO CInt
|
135 |
| - |
136 | 150 | foreign import capi safe "semaphore.h sem_wait"
|
137 | 151 | sem_wait :: Ptr () -> IO CInt
|
| 152 | +foreign import capi interruptible "semaphore.h sem_wait" |
| 153 | + sem_wait_interruptible :: Ptr () -> IO CInt |
138 | 154 | foreign import capi safe "semaphore.h sem_trywait"
|
139 | 155 | sem_trywait :: Ptr () -> IO CInt
|
140 | 156 | foreign import capi safe "semaphore.h sem_post"
|
|
0 commit comments