thread-local-storage 0.1.0.4 → 0.1.1

raw patch · 9 files changed

+124/−75 lines, 9 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• Data/TLS/GHC.hs +4/−2
• Data/TLS/PThread.hs +2/−0
• Data/TLS/PThread/Internal.hs +20/−13
• Data/TLS/TLS_Sig.hs +16/−2
• README.md +21/−0
• bench/Main.hs +24/−23
• tests/Main.hs +7/−7
• thread-local-storage.cabal +24/−28

@@ -0,0 +1,6 @@+## 0.1.1 [2017.01.22]+* Expose `Data.TLS.PThread.Internal`. Note that there are no API guarantees+  whatsoever with this module, so use it with caution.+* Add `pthread` to `extra-libraries`. Without it, some systems suffer+  from linker errors when using this library.+* Fix build on GHC 7.6 and 7.8.

@@ -17,11 +17,12 @@     , getTLS     , allTLS     , forEachTLS_+    , freeAllTLS+    -- * Deprecated, backwards compatibility     , freeTLS     ) where  import Control.Monad-import Control.Exception (evaluate) import Control.Concurrent import Data.Map.Strict as M import Data.IORef@@ -60,5 +61,6 @@   forM_ ls fn   -- Nothing to do here... we haven't pinned anything.  Normal GC is fine.-freeTLS _ = return ()+freeAllTLS _ =+  do return () 

@@ -18,6 +18,8 @@     , getTLS     , allTLS     , forEachTLS_+    , freeAllTLS+    -- * Deprecated, backwards compatibility     , freeTLS     )     where

@@ -3,17 +3,24 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} --- Export EVERYTHING from this internal module.+-- | Like "Data.TLS.PThread", but this also exports internal functionality+-- not exposed in the public interface.+--+-- There are no API guaranteees whatsoever for this module, so use it with+-- with caution. module Data.TLS.PThread.Internal where  import Control.Monad import Control.Exception-import Data.Word import Data.IORef import Foreign.Ptr import Foreign.StablePtr import Foreign.Storable(Storable(sizeOf))-    ++#if !(MIN_VERSION_base(4,8,0))+import Data.Word (Word)+#endif+ #include "../TLS_Sig.hs" -------------------------------------------------------------------------------- @@ -27,7 +34,7 @@  foreign import ccall unsafe    easy_make_pthread_key :: IO Key-                         + foreign import ccall unsafe    pthread_getspecific :: Key -> IO (StablePtr a) @@ -36,7 +43,7 @@  foreign import ccall unsafe    pthread_key_delete :: Key -> IO Int-                          + check_error :: () check_error = --  if get_pthread_key_size == sizeOf(0::Word)@@ -44,12 +51,12 @@  then ()  else error $ "Data.TLS.PThread: internal invariant broken!  Expected pthread_key_t to be word-sized!\n"              ++"Instead it was: "++show get_pthread_key_size-       + {-# INLINE setspecific #-} setspecific :: Key -> StablePtr a -> IO () setspecific k p = do-    code <- pthread_setspecific k p +    code <- pthread_setspecific k p     unless (code == 0) (error $ "pthread_setspecific returned error code: "++show code)  {-# INLINE delete #-}@@ -59,15 +66,15 @@ --    putStrLn $ "KEY DELETED: "++show k     unless (code == 0) (error $ "pthread_key_delete returned error code: "++show code)     return ()-           -           ++ --------------------------------------------------------------------------------  -- | A thread-local variable of type `a`. data TLS a = TLS { key       :: {-# UNPACK #-} !Key                  , mknew     :: !(IO a)                  , allCopies :: {-# UNPACK #-} !(IORef [StablePtr a]) }-    + mkTLS new = do   evaluate check_error   key  <- easy_make_pthread_key@@ -86,15 +93,15 @@    else     deRefStablePtr p -allTLS TLS{allCopies} = do +allTLS TLS{allCopies} = do     ls <- readIORef allCopies     mapM deRefStablePtr ls  forEachTLS_ tls fn = do   ls <- allTLS tls-  forM_ ls fn +  forM_ ls fn -freeTLS TLS{key,allCopies} = do +freeAllTLS TLS{key,allCopies} = do     ls <- readIORef allCopies     delete key     mapM_ freeStablePtr ls

@@ -30,8 +30,22 @@ -- | Like `allTLS`, but apply a computation directly rather than -- building a list. forEachTLS_ :: TLS a -> (a -> IO ()) -> IO ()-         ++               +-- | An alias for `freeAllTLS`.+freeTLS :: TLS a -> IO ()+freeTLS = freeAllTLS+{-# DEPRECATED freeTLS "Replaced by freeAllTLS" #-}+            -- | Release all copies of the TLS variable, across all threads.  This -- does not guarantee the storage will be freed immediately, but it -- guarantees that the storage can be reclaimed in the future.-freeTLS :: TLS a -> IO ()+--+-- The TLS value is still usable after this call, but any future calls+-- to `getTLS` must initialize new state.+--+-- Not thread safe.+freeAllTLS :: TLS a -> IO ()+++           

@@ -0,0 +1,21 @@+# `thread-local-storage`+[![Hackage](https://img.shields.io/hackage/v/thread-local-storage.svg)][Hackage: thread-local-storage]+[![Hackage Dependencies](https://img.shields.io/hackage-deps/v/thread-local-storage.svg)](http://packdeps.haskellers.com/reverse/thread-local-storage)+[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org]+[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3]++[Hackage: thread-local-storage]:+  http://hackage.haskell.org/package/thread-local-storage+  "thread-local-storage package on Hackage"+[Haskell.org]:+  http://www.haskell.org+  "The Haskell Programming Language"+[tl;dr Legal: BSD3]:+  https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29+  "BSD 3-Clause License (Revised)"++See .cabal file for description.++Here are some example benchmark results (on an Ivy Bridge i7-3770), with a typical time of 10.4 nanoseconds to get to a TLS variable given one IO thread per OS thread:++![example benchmarks](https://raw.githubusercontent.com/rrnewton/thread-local-storage/master/bench/example_results.png)

@@ -1,3 +1,4 @@+ {-# LANGUAGE BangPatterns #-}  module Main where@@ -12,18 +13,18 @@ import Criterion.Types import Criterion.Main import Data.Atomics.Counter-    + import Control.Monad import Control.Concurrent.MVar import Data.IORef import GHC.Conc-import System.Environment +import System.Environment ---------------------------------------------------------------------------------    + main :: IO () main = do   numProc <- getNumProcessors-  n       <- getNumCapabilities             +  n       <- getNumCapabilities   when (n == 1) $ do putStrLn "HACK: using setNumCapabilities to bump it up... should set this in the .cabal"                      setNumCapabilities numProc   numCap  <- getNumCapabilities@@ -36,8 +37,8 @@               then words $ " --regress=allocated:iters --regress=bytesCopied:iters --regress=cycles:iters "++                            " --regress=numGcs:iters --regress=mutatorWallSeconds:iters --regress=gcWallSeconds:iters "++                            " --regress=cpuTime:iters " ++-                           " -o tls_report.html " ---                         ++ " --raw tls_report.criterion "                                                  +                           " -o tls_report.html "+--                         ++ " --raw tls_report.criterion "               else args        threadify fn =@@ -46,34 +47,34 @@           | threads <- [1..numCap*4],             let suff = "_" ++ show threads ++"io_"++ show numCap++"os" ] -      mkTests name mkTLS getTLS freeTLS = bgroup name +      mkTests name mkTLS getTLS freeAllTLS = bgroup name          [            -- bench ("counter/getTLS/incrCntr"++suff) $            --       benchPar0 threads (GHC.mkTLS (newCounter 0))            --                     (\t -> incrCounter_ 1 =<< GHC.getTLS t)-           threadify $ \ (threads,suff) -> +           threadify $ \ (threads,suff) ->             bench ("counter/getTLS/readIORef"++suff) $                   benchPar0 threads (mkTLS (newIORef ()))                                 (\t -> readIORef =<< getTLS t)-                                freeTLS+                                freeAllTLS          ]-                   -  withArgs args' $ defaultMain $ -   [ mkTests "PThread" PT.mkTLS  PT.getTLS  PT.freeTLS-   , mkTests "GHC"     GHC.mkTLS GHC.getTLS GHC.freeTLS++  withArgs args' $ defaultMain $+   [ mkTests "PThread" PT.mkTLS  PT.getTLS  PT.freeAllTLS+   , mkTests "GHC"     GHC.mkTLS GHC.getTLS GHC.freeAllTLS    ] {-     bgroup "infrastructure"       [ bench ("benchPar1"++suff) $ benchPar1 threads (return ())       , bench ("benchPar0"++suff) $ benchPar0 threads (return ()) (\_ -> return ())---      , bench ("benchPar2"++suff) $ benchPar2 threads (return ())              -      ], -}          +--      , bench ("benchPar2"++suff) $ benchPar2 threads (return ())+      ], -}     -- | ]   where -                + ----------------------------------------------------------------------------------------------------  benchPar0 :: Int -> IO a -> (a -> IO ()) -> (a -> IO ()) -> Benchmarkable@@ -87,7 +88,7 @@   let totalIters = (fromIntegral iters) * (max numCap numT)       perThread  = totalIters `quot` numT   mvs <- forM [0..numT-1] $ \ n -> do-    v <- newEmptyMVar +    v <- newEmptyMVar     _ <- forkOn n $ do rep perThread (fn x)                        putMVar v ()     return v@@ -100,13 +101,13 @@ -- | Benchmarking the same action on ALL of N threads. --   This version uses MVar synchronization. benchPar1 :: Int -> IO () -> Benchmarkable-benchPar1 num act = Benchmarkable $ \ iters -> do                      +benchPar1 num act = Benchmarkable $ \ iters -> do   mvs <- forM [0..num-1] $ \ n -> do-    v <- newEmptyMVar +    v <- newEmptyMVar     _ <- forkOn n $ do rep (fromIntegral iters) act                        putMVar v ()     return v-  forM_ mvs takeMVar           +  forM_ mvs takeMVar {-# INLINE benchPar1 #-}  -- | This version never blocks on an MVar.@@ -120,7 +121,7 @@               waitCounter   forM_ [1..num-1] $ \ n -> forkOn n go   go-  + {-# INLINE benchPar2 #-}  -- | My own forM for inclusive numeric ranges (not requiring deforestation optimizations).@@ -128,8 +129,8 @@ for_ start end _fn | start > end = error "for_: start is greater than end" for_ start end fn = loop start   where-   loop !i | i > end  = return ()-	   | otherwise = do fn i; loop (i+1)+   loop !i | i > end   = return ()+           | otherwise = do fn i; loop (i+1) {-# INLINE for_ #-}  rep :: Monad m => Int -> (m ()) -> m ()

@@ -5,11 +5,11 @@  -- import Data.Atomics import Data.IORef-import Foreign.Ptr+-- import Foreign.Ptr import GHC.Conc import Control.Concurrent.MVar import Control.Monad-import Control.Exception+-- import Control.Exception import System.Mem.StableName  main :: IO ()@@ -17,16 +17,16 @@   putStrLn "Run a very simple TLs test"   putStrLn $ "pethread_key_t size: "++show PThread.get_pthread_key_size -  testIt "GHC" GHC.mkTLS GHC.getTLS GHC.allTLS GHC.freeTLS-  testIt "PThread" PThread.mkTLS PThread.getTLS PThread.allTLS PThread.freeTLS+  testIt "GHC" GHC.mkTLS GHC.getTLS GHC.allTLS GHC.freeAllTLS+  testIt "PThread" PThread.mkTLS PThread.getTLS PThread.allTLS PThread.freeAllTLS  testIt :: Show b => String        -> (IO (IORef Int) -> IO t)        -> (t -> IO (IORef Int))        -> (t -> IO [IORef b])-       -> (t -> IO a)+       -> (t -> IO ())        -> IO ()-testIt name mkTLS getTLS allTLS freeTLS = do+testIt name mkTLS getTLS allTLS freeAllTLS = do   putStrLn$ "\n  Testing "++name ++" implementation: "   putStrLn "----------------------------------------"   numCap <- getNumCapabilities@@ -54,7 +54,7 @@   putStrLn$ "Results: "++show ls2   ls3 <- mapM ssn ls   putStrLn$ "Result, stable names: "++show ls3-  freeTLS tls+  freeAllTLS tls   {- forM_ [1..(10::Int)] $ \_ -> do      r   <- getTLS tls     n   <- readIORef r

@@ -1,52 +1,52 @@--- Initial thread-local-storage.cabal generated by cabal init.  For further---  documentation, see http://haskell.org/cabal/users-guide/- name:                thread-local-storage-version:             0.1.0.4+version:             0.1.1 synopsis:            Several options for thread-local-storage (TLS) in Haskell. description:    .    Thread-local storage, or TLS, is an important ingredient in many    algorithms and data structures.-   . +   .    The GHC compiler does not provide a built-in notion of TLS either    at the IO-thread or OS thread level.  This package provides a few    different implementations of a simple TLS API.-   . -   All exported modules provide exactly the same interface with+   .+   All exported public modules provide exactly the same interface with    different implementations.  Run the included criterion benchmark    suite to ascertain which performs the best on your platform.-   . +   .    Example criterion benchmark data can be found here (from an Intel Ivy-Bridge i7-3770 desktop):       <http://www.cs.indiana.edu/~rrnewton/datasets/xmen_tls_report.html>-           -         ++homepage:            https://github.com/rrnewton/thread-local-storage+bug-reports:         https://github.com/rrnewton/thread-local-storage/issues license:             BSD3 license-file:        LICENSE author:              Ryan Newton maintainer:          rrnewton@gmail.com--- copyright:            category:            System build-type:          Simple--- extra-source-files:   cabal-version:       >=1.10 -extra-source-files:  Data/TLS/TLS_Sig.hs+extra-source-files:  CHANGELOG.md, README.md, Data/TLS/TLS_Sig.hs +source-repository head+  type:     git+  location: https://github.com/rrnewton/thread-local-storage+ library   exposed-modules:     Data.TLS.GHC,                        Data.TLS.PThread                    -- Not finished yet:                    --  Data.TLS.GCC-  other-modules:       Data.TLS.PThread.Internal+                       Data.TLS.PThread.Internal   other-extensions:    BangPatterns, NamedFieldPuns, CPP   build-depends:       base >=4.6 && < 5.0,                        containers >=0.5-  -- hs-source-dirs:         default-language:    Haskell2010-  ghc-options: -O2-  c-sources: cbits/helpers.c  -     +  ghc-options: -Wall -O2+  c-sources: cbits/helpers.c+  extra-libraries: pthread+ benchmark bench-haskell-tls   main-is: Main.hs   hs-source-dirs: ./bench/@@ -56,19 +56,15 @@                  criterion >= 1.0,                  atomic-primops >= 0.6.0.6   default-language:    Haskell2010-  ghc-options: -rtsopts -O2 -threaded -with-rtsopts=-T - +  ghc-options: -Wall -rtsopts -O2 -threaded -with-rtsopts=-T + test-suite test-tls   main-is: Main.hs-  -- Here we reinclude/rebuild the main sources so we can test the .Internal module:-  hs-source-dirs: ./ ./tests/+  hs-source-dirs: tests   type: exitcode-stdio-1.0   build-depends: base >= 4.6 && < 5.0,-                 atomic-primops >= 0.6.0.6+                 atomic-primops >= 0.6.0.6,+                 thread-local-storage   default-language:    Haskell2010-  ghc-options: -rtsopts -O2 -threaded -with-rtsopts=-N4--  -- DUPLICATED, from above:-  build-depends: containers >=0.5-  c-sources: cbits/helpers.c       +  ghc-options: -Wall -rtsopts -O2 -threaded -with-rtsopts=-N4