diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Change Log + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](http://keepachangelog.com/). + +## [0.1] - 2017-09-08 + +### Added + +* Bindings for thread-local storage management. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright EURL Tweag (c) 2017 +Copyright LeapYear Tecnologies (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ +# pthread: Bindings for pthread + +[![CircleCI](https://circleci.com/gh/tweag/pthread.svg?style=svg)](https://circleci.com/gh/tweag/pthread) + +## Sponsors + +         +[![Tweag I/O](http://i.imgur.com/0HK8X4y.png)](http://tweag.io) +             +[![LeapYear](http://i.imgur.com/t9VxRHn.png)](http://leapyear.io) + +pthread is maintained by [Tweag I/O](http://tweag.io/). + +Have questions? Need help? Tweet at +[@tweagio](http://twitter.com/tweagio). diff --git a/pthread.cabal b/pthread.cabal new file mode 100644 --- /dev/null +++ b/pthread.cabal @@ -0,0 +1,29 @@ +name: pthread +version: 0.1 +synopsis: Bindings for the pthread library. +homepage: http://github.com/tweag/pthreads +license: BSD3 +license-file: LICENSE +author: Tweag I/O +maintainer: facundo.dominguez@tweag.io +copyright: 2017 EURL Tweag + 2017 LeapYear Technologies. +category: FFI, System +build-type: Simple +cabal-version: >=1.10 +extra-source-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/tweag/pthreads + +library + hs-source-dirs: src + extra-libraries: pthread + exposed-modules: + Foreign.Concurrent.PThread + build-depends: + base > 4.9.0.0 && < 5 + default-language: Haskell2010 diff --git a/src/Foreign/Concurrent/PThread.hsc b/src/Foreign/Concurrent/PThread.hsc new file mode 100644 --- /dev/null +++ b/src/Foreign/Concurrent/PThread.hsc @@ -0,0 +1,76 @@ +-- | PThread bindings + +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +-- see comment on the imports of Data.Int and Data.Word +{-# OPTIONS_GHC -Wno-unused-imports #-} +module Foreign.Concurrent.PThread + ( -- * thread local storage + Key + , keyCreate + , keyDelete + , setSpecific + , getSpecific + ) where + +import Control.Concurrent (isCurrentThreadBound, rtsSupportsBoundThreads) +import Control.Monad ((>=>), unless, when) +import Foreign.C.Types +import Foreign.Marshal.Alloc (alloca) +import Foreign.Ptr +import Foreign.Storable + +-- These two might be used depending on what the Key representation expands to. +import Data.Int +import Data.Word + +#include + +-- | Stands for @pthread_key_t@. +newtype Key = Key #{type pthread_key_t} + deriving (Eq, Ord, Show, Storable) +-- We check in cbits/checks.c that the size of pthread_key_t fits unsigned int. + +foreign import capi unsafe "pthread.h" + pthread_key_create :: Ptr Key -> FunPtr (Ptr a -> IO ()) -> IO CInt + +-- | Stands for @pthread_key_create@. +keyCreate :: FunPtr (Ptr a -> IO ()) -> IO Key +keyCreate destructor = alloca $ \keyPtr -> + pthread_key_create keyPtr destructor >>= checkReturnCode >> peek keyPtr + +foreign import capi unsafe "pthread.h" + pthread_key_delete :: Key -> IO CInt + +-- | Stands for @pthread_key_delete@. +keyDelete :: Key -> IO () +keyDelete = pthread_key_delete >=> checkReturnCode + +foreign import capi unsafe "pthread.h" + pthread_setspecific :: Key -> Ptr a -> IO CInt + +-- | Stands for @pthread_setspecific@. +setSpecific :: Key -> Ptr a -> IO () +setSpecific k v = checkBoundness >> pthread_setspecific k v >>= checkReturnCode + +foreign import capi unsafe "pthread.h" + pthread_getspecific :: Key -> IO (Ptr a) + +-- | Stands for @pthread_getspecific@. +getSpecific :: Key -> IO (Ptr a) +getSpecific k = do + checkBoundness + pthread_getspecific k + +-- | Yields an error if the calling thread is not bound. +checkBoundness :: IO () +checkBoundness = when rtsSupportsBoundThreads $ do + bound <- isCurrentThreadBound + unless bound $ + fail "pthread: checkBoundness: Calling thread is not bound" + +-- | Yields an error if the passed integer is not zero. +checkReturnCode :: CInt -> IO () +checkReturnCode rc = when (rc /= 0) $ + fail $ "pthread: checkReturnCode: non-zero return code: " ++ show rc