
   0 | module System.Posix.Pthreads.Prim
   1 | 
   2 | import public Data.C.Ptr
   3 | import public System.Posix.Errno
   4 | import public System.Posix.Pthreads.Struct
   5 | import public System.Posix.Pthreads.Types
   6 | import System.Posix.Signal
   7 | import System.Posix.Time
   8 | 
   9 | %default total
  10 | 
  11 | --------------------------------------------------------------------------------
  12 | -- FFI
  13 | --------------------------------------------------------------------------------
  14 | 
  15 | %foreign "C:pthread_self, posix-idris"
  16 | prim__pthread_self : PrimIO AnyPtr
  17 | 
  18 | %foreign "C:li_pthread_join, posix-idris"
  19 | prim__pthread_join : AnyPtr -> PrimIO Bits32
  20 | 
  21 | %foreign "C:li_pthread_mutex_init, posix-idris"
  22 | prim__pthread_mutex_init : AnyPtr -> Bits8 -> PrimIO Bits32
  23 | 
  24 | %foreign "C:li_pthread_mutex_destroy, posix-idris"
  25 | prim__pthread_mutex_destroy : AnyPtr -> PrimIO ()
  26 | 
  27 | %foreign "C:pthread_mutex_lock, posix-idris"
  28 | prim__pthread_mutex_lock : AnyPtr -> PrimIO Bits32
  29 | 
  30 | %foreign "C:pthread_mutex_trylock, posix-idris"
  31 | prim__pthread_mutex_trylock : AnyPtr -> PrimIO Bits32
  32 | 
  33 | %foreign "C:pthread_mutex_timedlock, posix-idris"
  34 | prim__pthread_mutex_timedlock : AnyPtr -> AnyPtr -> PrimIO Bits32
  35 | 
  36 | %foreign "C:pthread_mutex_unlock, posix-idris"
  37 | prim__pthread_mutex_unlock : AnyPtr -> PrimIO Bits32
  38 | 
  39 | %foreign "C:li_pthread_cond_init, posix-idris"
  40 | prim__pthread_cond_init : AnyPtr -> PrimIO Bits32
  41 | 
  42 | %foreign "C:li_pthread_cond_destroy, posix-idris"
  43 | prim__pthread_cond_destroy : AnyPtr -> PrimIO ()
  44 | 
  45 | %foreign "C:pthread_cond_signal, posix-idris"
  46 | prim__pthread_cond_signal : AnyPtr -> PrimIO Bits32
  47 | 
  48 | %foreign "C:pthread_cond_broadcast, posix-idris"
  49 | prim__pthread_cond_broadcast : AnyPtr -> PrimIO Bits32
  50 | 
  51 | %foreign "C:pthread_cond_wait, posix-idris"
  52 | prim__pthread_cond_wait : AnyPtr -> AnyPtr -> PrimIO Bits32
  53 | 
  54 | %foreign "C:pthread_cond_timedwait, posix-idris"
  55 | prim__pthread_cond_timedwait : AnyPtr -> AnyPtr -> AnyPtr -> PrimIO Bits32
  56 | 
  57 | %foreign "C:pthread_cancel, posix-idris"
  58 | prim__pthread_cancel : AnyPtr -> PrimIO Bits32
  59 | 
  60 | %foreign "C:li_pthread_setcanceltype, posix-idris"
  61 | prim__pthread_setcanceltype : Bits8 -> PrimIO Bits8
  62 | 
  63 | %foreign "C:li_pthread_setcancelstate, posix-idris"
  64 | prim__pthread_setcancelstate : Bits8 -> PrimIO Bits8
  65 | 
  66 | %foreign "C:li_pthread_sigmask1, posix-idris"
  67 | prim__pthread_sigmask1 : Bits8 -> AnyPtr -> PrimIO ()
  68 | 
  69 | %foreign "C:li_pthread_sigmask, posix-idris"
  70 | prim__pthread_sigmask : Bits8 -> AnyPtr -> PrimIO AnyPtr
  71 | 
  72 | %foreign "C:li_pthread_siggetmask, posix-idris"
  73 | prim__pthread_siggetmask : PrimIO AnyPtr
  74 | 
  75 | %foreign "C:pthread_kill, posix-idris"
  76 | prim__pthread_kill : AnyPtr -> Bits32 -> PrimIO Bits32
  77 | 
  78 | --------------------------------------------------------------------------------
  79 | -- API
  80 | --------------------------------------------------------------------------------
  81 | 
  82 | ||| Returns the thread ID of the current thread.
  83 | export %inline
  84 | pthreadSelf : PrimIO PthreadT
  85 | pthreadSelf = primMap P $ prim__pthread_self
  86 | 
  87 | ||| Blocks the current thread and waits for the given thread to terminate.
  88 | export %inline
  89 | pthreadJoin : PthreadT -> EPrim ()
  90 | pthreadJoin p = posToUnit $ prim__pthread_join p.ptr
  91 | 
  92 | --------------------------------------------------------------------------------
  93 | -- MutexT
  94 | --------------------------------------------------------------------------------
  95 | 
  96 | %inline
  97 | Struct SMutexT where
  98 |   sunwrap = ptr
  99 |   swrap   = M
 100 | 
 101 | %inline
 102 | SizeOf MutexT where sizeof_ = mutex_t_size
 103 | 
 104 | ||| Allocates and initializes a new mutex of the given type.
 105 | |||
 106 | ||| This must be freed with `destroyMutex`.
 107 | export
 108 | mkmutex : MutexType -> EPrim MutexT
 109 | mkmutex mt t =
 110 |   let m # t := primStruct SMutexT t
 111 |       x # t := toF1 (prim__pthread_mutex_init (unwrap m) (mutexCode mt)) t
 112 |    in case x of
 113 |         0 => R m t
 114 |         x => freeFail m (EN x) t
 115 | 
 116 | ||| Destroys a mutex and frees the memory allocated for it.
 117 | export %inline
 118 | destroyMutex : MutexT -> PrimIO ()
 119 | destroyMutex m = prim__pthread_mutex_destroy (unwrap m)
 120 | 
 121 | ||| Tries to lock the given mutex, blocking the calling thread
 122 | ||| in case it is already locked.
 123 | export %inline
 124 | lockMutex : MutexT -> EPrim ()
 125 | lockMutex p = posToUnit $ prim__pthread_mutex_lock (unwrap p)
 126 | 
 127 | ||| Like `lockMutex` but returns a boolean with `False` indicating
 128 | ||| that the lock timed out
 129 | export
 130 | timedlockMutex : MutexT -> Clock Duration -> EPrim Bool
 131 | timedlockMutex p cl =
 132 |   withTimespec cl $ \ts =>
 133 |     posNotErr ETIMEDOUT (prim__pthread_mutex_timedlock (unwrap p) (unwrap ts))
 134 | 
 135 | ||| Like `lockMutex` but returns `False` in case the mutex is
 136 | ||| already locked.
 137 | export
 138 | trylockMutex : MutexT -> EPrim Bool
 139 | trylockMutex p =
 140 |   posNotErr EBUSY (prim__pthread_mutex_trylock $ unwrap p)
 141 | 
 142 | ||| Unlocks the given mutex.
 143 | |||
 144 | ||| This is an error if the calling thread is not the one holding
 145 | ||| the mutex's lock.
 146 | export %inline
 147 | unlockMutex : MutexT -> EPrim ()
 148 | unlockMutex p = posToUnit $ prim__pthread_mutex_unlock (unwrap p)
 149 | 
 150 | --------------------------------------------------------------------------------
 151 | -- CondT
 152 | --------------------------------------------------------------------------------
 153 | 
 154 | %inline
 155 | Struct SCondT where
 156 |   sunwrap = ptr
 157 |   swrap   = C
 158 | 
 159 | %inline
 160 | SizeOf CondT where sizeof_ = cond_t_size
 161 | 
 162 | ||| Allocates and initializes a new condition variable.
 163 | |||
 164 | ||| This must be freed with `destroyCond`.
 165 | export
 166 | mkcond : EPrim CondT
 167 | mkcond t =
 168 |   let m # t := primStruct SCondT t
 169 |       x # t := toF1 (prim__pthread_cond_init m.ptr) t
 170 |    in case x of
 171 |         0 => R m t
 172 |         x => freeFail m (EN x) t
 173 | 
 174 | ||| Destroys a condition variable and frees the memory allocated for it.
 175 | export %inline
 176 | destroyCond : CondT -> PrimIO ()
 177 | destroyCond m = prim__pthread_cond_destroy m.ptr
 178 | 
 179 | ||| Signals the given `pthread_cond_t`.
 180 | |||
 181 | ||| If several threads are waiting on the condition, it is unspecified
 182 | ||| which of them will be signalled. We are only guaranteed that at least
 183 | ||| of them will be woken up.
 184 | export %inline
 185 | condSignal : CondT -> EPrim ()
 186 | condSignal p = posToUnit $ prim__pthread_cond_signal p.ptr
 187 | 
 188 | ||| Broadcasts the given `pthread_cond_t`.
 189 | |||
 190 | ||| This will wake up all threads waiting on the given condition.
 191 | export %inline
 192 | condBroadcast : CondT -> EPrim ()
 193 | condBroadcast p = posToUnit $ prim__pthread_cond_broadcast p.ptr
 194 | 
 195 | ||| Blocks the given thread and waits for the given condition to
 196 | ||| be signalled.
 197 | |||
 198 | ||| Note: The mutex must have been locked by the calling thread. The
 199 | ||| lock is automatically released upon calling `condWait`, and when
 200 | ||| the thread is woken up, the mutex will automatically be locked again.
 201 | export %inline
 202 | condWait : CondT -> MutexT -> EPrim ()
 203 | condWait p m = posToUnit $ prim__pthread_cond_wait p.ptr m.ptr
 204 | 
 205 | ||| Like `condWait` but will return `False` in case the operation timed out.
 206 | export %inline
 207 | condTimedwait : CondT -> MutexT -> Clock UTC -> EPrim Bool
 208 | condTimedwait p m cl =
 209 |   withTimespec cl $ \ts =>
 210 |     posNotErr ETIMEDOUT (prim__pthread_cond_timedwait p.ptr m.ptr (unwrap ts))
 211 | 
 212 | --------------------------------------------------------------------------------
 213 | -- Thread Cancelation
 214 | --------------------------------------------------------------------------------
 215 | 
 216 | toTpe : Bits8 -> CancelType
 217 | toTpe b =
 218 |   if b == cancelType CANCEL_DEFERRED then CANCEL_DEFERRED else CANCEL_ASYNCHRONOUS
 219 | 
 220 | toSt : Bits8 -> CancelState
 221 | toSt b =
 222 |   if b == cancelState CANCEL_ENABLE then CANCEL_ENABLE else CANCEL_DISABLE
 223 | 
 224 | ||| Sends a cancelation request to the given thread.
 225 | export %inline
 226 | pthreadCancel : PthreadT -> EPrim ()
 227 | pthreadCancel t = posToUnit $ prim__pthread_cancel t.ptr
 228 | 
 229 | ||| Tests for thread cancelation in the absence of other cancelation
 230 | ||| points.
 231 | export %foreign "C:pthread_testcancel, posix-idris"
 232 | pthreadTestCancel : PrimIO ()
 233 | 
 234 | ||| Sets the current thread's cancel type returning the previous cancel type.
 235 | export %inline
 236 | setCancelType : CancelType -> PrimIO CancelType
 237 | setCancelType t = primMap toTpe $ prim__pthread_setcanceltype (cancelType t)
 238 | 
 239 | ||| Sets the current thread's cancel state returning the previous cancel state.
 240 | export %inline
 241 | setCancelState : CancelState -> PrimIO CancelState
 242 | setCancelState t = primMap toSt $ prim__pthread_setcancelstate (cancelState t)
 243 | 
 244 | --------------------------------------------------------------------------------
 245 | -- Signals and Threads
 246 | --------------------------------------------------------------------------------
 247 | 
 248 | ||| Adjust the thread's signal mask according to the given `How`
 249 | ||| and signal set.
 250 | |||
 251 | ||| Note: This allocates a new `sigset_t` pointer and returns the
 252 | |||       previously set signal mask. Client code is responsible to
 253 | |||       free the memory for this once it is no longer used.
 254 | |||       See also `pthreadSigmask'` for a version that does not return
 255 | |||       the previous signal mask.
 256 | export %inline
 257 | pthreadSigmask_ : How -> SigsetT -> PrimIO SigsetT
 258 | pthreadSigmask_ h p w =
 259 |   let MkIORes p2 w := prim__pthread_sigmask (howCode h) (unwrap p) w
 260 |    in MkIORes (wrap p2) w
 261 | 
 262 | ||| Returns the current signal mask of the thread.
 263 | |||
 264 | ||| Note: This allocates a new `sigset_t` pointer and returns the
 265 | |||       previously set signal mask. Client code is responsible to
 266 | |||       free the memory for this once it is no longer used.
 267 | export %inline
 268 | pthreadSiggetmask : PrimIO SigsetT
 269 | pthreadSiggetmask w =
 270 |   let MkIORes p w := prim__pthread_siggetmask w
 271 |    in MkIORes (wrap p) w
 272 | 
 273 | ||| Sends the given signal to the given thread.
 274 | export %inline
 275 | pthreadKill : PthreadT -> Signal -> EPrim ()
 276 | pthreadKill t s = posToUnit $ prim__pthread_kill t.ptr s.sig
 277 | 
 278 | --------------------------------------------------------------------------------
 279 | -- Convenience API
 280 | --------------------------------------------------------------------------------
 281 | 
 282 | ||| Like `pthreadSigmask_` but does not allocate a pointer for the
 283 | ||| previous `sigset_t`.
 284 | export %inline
 285 | pthreadSigmask : How -> List Signal -> EPrim ()
 286 | pthreadSigmask h ss =
 287 |   withSignals ss $ \p,t =>
 288 |    let _ # t := toF1 (prim__pthread_sigmask1 (howCode h) (unwrap p)) t
 289 |     in R () t
 290 |