git.iko.soy/typeable/attoparsec
on master help sign in
Back out the atomic increment change
9f07ac2Bryan O'Sullivan
Data/Attoparsec/ByteString/Buffer.hs+7−11
compare with master
unifiedsplit
@@ -1,4 +1,3 @@
1−{-# LANGUAGE ForeignFunctionInterface #-}
2-- |
1-- |
3-- Module : Data.Attoparsec.ByteString.Buffer
2-- Module : Data.Attoparsec.ByteString.Buffer
4-- Copyright : Bryan O'Sullivan 2007-2014
3-- Copyright : Bryan O'Sullivan 2007-2014
@@ -32,17 +31,15 @@ module Data.Attoparsec.ByteString.Buffer
32 , unsafeDrop
31 , unsafeDrop
33 ) where
32 ) where
34
33
35−import Control.Applicative ((<$>))
36import Control.Exception (assert)
34import Control.Exception (assert)
37import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
35import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
38import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
36import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
39import Data.List (foldl1')
37import Data.List (foldl1')
40import Data.Monoid (Monoid(..))
38import Data.Monoid (Monoid(..))
41import Data.Word (Word8)
39import Data.Word (Word8)
42−import Foreign.C.Types (CLong(..))
43import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
40import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
44−import Foreign.Ptr (Ptr, castPtr, plusPtr)
41+import Foreign.Ptr (castPtr, plusPtr)
45−import Foreign.Storable (peekByteOff, poke, sizeOf)
42+import Foreign.Storable (peek, peekByteOff, poke, sizeOf)
46import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
43import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
47import Prelude hiding (length)
44import Prelude hiding (length)
48
45
@@ -78,13 +75,15 @@ instance Monoid Buffer where
78 newlen = len0 + len1
75 newlen = len0 + len1
79 gen <- if gen0 == 0
76 gen <- if gen0 == 0
80 then return 0
77 then return 0
81− else fromIntegral <$> atomic_inc (castPtr ptr0)
78+ else peek (castPtr ptr0)
82− if newlen <= cap0 && gen == gen0 + 1
79+ if gen == gen0 && newlen <= cap0
83 then do
80 then do
81+ let newgen = gen + 1
82+ poke (castPtr ptr0) newgen
84 memcpy (ptr0 `plusPtr` (off0+len0))
83 memcpy (ptr0 `plusPtr` (off0+len0))
85 (ptr1 `plusPtr` off1)
84 (ptr1 `plusPtr` off1)
86 (fromIntegral len1)
85 (fromIntegral len1)
87− return (Buf fp0 off0 newlen cap0 gen)
86+ return (Buf fp0 off0 newlen cap0 newgen)
88 else do
87 else do
89 let newcap = newlen * 2
88 let newcap = newlen * 2
90 fp <- mallocPlainForeignPtrBytes (newcap + genSize)
89 fp <- mallocPlainForeignPtrBytes (newcap + genSize)
@@ -121,6 +120,3 @@ unsafeDrop s (Buf fp off len _ _) =
121 assert (s >= 0 && s <= len) $
120 assert (s >= 0 && s <= len) $
122 PS fp (off+s) (len-s)
121 PS fp (off+s) (len-s)
123{-# INLINE unsafeDrop #-}
122{-# INLINE unsafeDrop #-}
124−
125−foreign import ccall unsafe "_atto_atomic_inc" atomic_inc
126− :: Ptr CLong -> IO CLong
attoparsec.cabal−3
@@ -45,7 +45,6 @@ library
45 deepseq,
45 deepseq,
46 scientific >= 0.3.1 && < 0.4,
46 scientific >= 0.3.1 && < 0.4,
47 text >= 1.1.1.3
47 text >= 1.1.1.3
48− c-sources: cbits/cbits.c
49 if impl(ghc < 7.4)
48 if impl(ghc < 7.4)
50 build-depends:
49 build-depends:
51 bytestring < 0.10.4.0
50 bytestring < 0.10.4.0
@@ -80,7 +79,6 @@ library
80test-suite tests
79test-suite tests
81 type: exitcode-stdio-1.0
80 type: exitcode-stdio-1.0
82 hs-source-dirs: tests .
81 hs-source-dirs: tests .
83− c-sources: cbits/cbits.c
84 main-is: QC.hs
82 main-is: QC.hs
85 other-modules: QC.Buffer
83 other-modules: QC.Buffer
86 QC.ByteString
84 QC.ByteString
@@ -108,7 +106,6 @@ test-suite tests
108benchmark benchmarks
106benchmark benchmarks
109 type: exitcode-stdio-1.0
107 type: exitcode-stdio-1.0
110 hs-source-dirs: benchmarks, .
108 hs-source-dirs: benchmarks, .
111− c-sources: cbits/cbits.c
112 ghc-options: -O2 -Wall -rtsopts
109 ghc-options: -O2 -Wall -rtsopts
113 main-is: Benchmarks.hs
110 main-is: Benchmarks.hs
114 other-modules:
111 other-modules:
benchmarks/attoparsec-benchmarks.cabal−1
@@ -15,7 +15,6 @@ executable attoparsec-benchmarks
15 Links
15 Links
16 Numbers
16 Numbers
17 hs-source-dirs: .. .
17 hs-source-dirs: .. .
18− c-sources: ../cbits/cbits.c
19 ghc-options: -O2 -Wall -rtsopts
18 ghc-options: -O2 -Wall -rtsopts
20 build-depends:
19 build-depends:
21 array,
20 array,
cbits/cbits.cdeleted−4
@@ -1,4 +0,0 @@
1−long _atto_atomic_inc(long *ptr)
2−{
3− return __sync_fetch_and_add(ptr, 1);
4−}