c26d059 · typeable/attoparsec

git.iko.soy/typeable/attoparsec

Unacceptably slow thread-safe duplicate write detection

The atomic increments slow down the code by horrifying amounts (a factor of 2 or so for the takeWhile benchmark, for instance).

commitc26d0591b8e0d4ef5537d242031e894979491d08 authorBryan O'Sullivan <bos@serpentine.com> dateThu 29 May 2014, 23:18 (12 years ago) parentb9db7e7

4 files changed+19−7

compare with master

unifiedsplit

Data/Attoparsec/ByteString/Buffer.hs+11−7 attoparsec.cabal+3 benchmarks/attoparsec-benchmarks.cabal+1 cbits/cbits.c+4

Data/Attoparsec/ByteString/Buffer.hs+11−7

@@ -1,3 +1,4 @@

1+{-# LANGUAGE ForeignFunctionInterface #-}

12-- |

23-- Module : Data.Attoparsec.ByteString.Buffer

34-- Copyright : Bryan O'Sullivan 2007-2014

@@ -31,15 +32,17 @@ module Data.Attoparsec.ByteString.Buffer

3132 , unsafeDrop

3233 ) where

3334

35+import Control.Applicative ((<$>))

3436import Control.Exception (assert)

3537import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)

3638import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)

3739import Data.List (foldl1')

3840import Data.Monoid (Monoid(..))

3941import Data.Word (Word8)

42+import Foreign.C.Types (CLong(..))

4043import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)

41−import Foreign.Ptr (castPtr, plusPtr)

42−import Foreign.Storable (peek, peekByteOff, poke, sizeOf)

44+import Foreign.Ptr (Ptr, castPtr, plusPtr)

45+import Foreign.Storable (peekByteOff, poke, sizeOf)

4346import GHC.ForeignPtr (mallocPlainForeignPtrBytes)

4447import Prelude hiding (length)

4548

@@ -75,15 +78,13 @@ instance Monoid Buffer where

7578 newlen = len0 + len1

7679 gen <- if gen0 == 0

7780 then return 0

78− else peek (castPtr ptr0)

79− if gen == gen0 && newlen <= cap0

81+ else fromIntegral <$> atomic_inc (castPtr ptr0)

82+ if newlen <= cap0 && gen == gen0 + 1

8083 then do

81− let newgen = gen + 1

82− poke (castPtr ptr0) newgen

8384 memcpy (ptr0 `plusPtr` (off0+len0))

8485 (ptr1 `plusPtr` off1)

8586 (fromIntegral len1)

86− return (Buf fp0 off0 newlen cap0 newgen)

87+ return (Buf fp0 off0 newlen cap0 gen)

8788 else do

8889 let newcap = newlen * 2

8990 fp <- mallocPlainForeignPtrBytes (newcap + genSize)

@@ -120,3 +121,6 @@ unsafeDrop s (Buf fp off len _ _) =

120121 assert (s >= 0 && s <= len) $

121122 PS fp (off+s) (len-s)

122123{-# INLINE unsafeDrop #-}

124+

125+foreign import ccall unsafe "_atto_atomic_inc" atomic_inc

126+ :: Ptr CLong -> IO CLong

attoparsec.cabal+3

@@ -45,6 +45,7 @@ library

4545 deepseq,

4646 scientific >= 0.3.1 && < 0.4,

4747 text >= 1.1.1.3

48+ c-sources: cbits/cbits.c

4849 if impl(ghc < 7.4)

4950 build-depends:

5051 bytestring < 0.10.4.0

@@ -79,6 +80,7 @@ library

7980test-suite tests

8081 type: exitcode-stdio-1.0

8182 hs-source-dirs: tests .

83+ c-sources: cbits/cbits.c

8284 main-is: QC.hs

8385 other-modules: QC.Buffer

8486 QC.ByteString

@@ -106,6 +108,7 @@ test-suite tests

106108benchmark benchmarks

107109 type: exitcode-stdio-1.0

108110 hs-source-dirs: benchmarks, .

111+ c-sources: cbits/cbits.c

109112 ghc-options: -O2 -Wall -rtsopts

110113 main-is: Benchmarks.hs

111114 other-modules:

benchmarks/attoparsec-benchmarks.cabal+1

@@ -15,6 +15,7 @@ executable attoparsec-benchmarks

1515 Links

1616 Numbers

1717 hs-source-dirs: .. .

18+ c-sources: ../cbits/cbits.c

1819 ghc-options: -O2 -Wall -rtsopts

1920 build-depends:

2021 array,

cbits/cbits.cnew file+4

@@ -0,0 +1,4 @@

1+long _atto_atomic_inc(long *ptr)

2+{

3+ return __sync_fetch_and_add(ptr, 1);

4+}