├── Setup.hs ├── .gitignore ├── .travis.yml ├── Readme.md ├── perf ├── Util.hs ├── TChan │ ├── Unicast.hs │ └── Multicast.hs ├── Main.hs └── Disruptor3 │ ├── Unicast.hs │ ├── Multicast.hs │ └── Diamond.hs ├── src └── Data │ ├── RingBuffer │ ├── SequenceBarrier.hs │ ├── Sequencer │ │ ├── Internal.hs │ │ ├── SingleProducer.hs │ │ └── MultiProducer.hs │ ├── RingBuffer.hs │ ├── Sequence.hs │ └── Sequencer.hs │ └── RingBuffer.hs ├── data-ringbuffer.cabal └── LICENSE /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | *.swp 3 | cabal-dev 4 | .cabal-sandbox 5 | *.hi 6 | *.o 7 | cabal.sandbox.config 8 | tags 9 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: haskell 2 | install: cabal install --only-dependencies --enable-benchmarks 3 | script: cabal configure --enable-benchmarks && cabal build && cabal bench 4 | notifications: 5 | email: 6 | - kim.altintop@gmail.com 7 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | # Ring Buffer 2 | 3 | [![Build Status](https://secure.travis-ci.org/kim/data-ringbuffer.png)](http://travis-ci.org/kim/data-ringbuffer) 4 | 5 | Haskell implementation of a concurrent, lock-free, queue-like data structure 6 | (actually a ring buffer), inspired by ["Disruptor"](http://code.google.com/p/disruptor). 7 | 8 | ## Build 9 | 10 | ```sh 11 | $ # build the library and tests 12 | $ cabal configure --enable-benchmarks 13 | $ # run the benchmarks 14 | $ GHCRTS='-N' cabal bench 15 | ``` 16 | -------------------------------------------------------------------------------- /perf/Util.hs: -------------------------------------------------------------------------------- 1 | module Util 2 | ( printTiming 3 | , now 4 | ) where 5 | 6 | import Data.Time.Clock.POSIX (getPOSIXTime) 7 | import Text.Printf (printf) 8 | 9 | now :: IO Double 10 | now = realToFrac `fmap` getPOSIXTime 11 | 12 | printTiming :: Int -> Double -> Double -> IO () 13 | printTiming iters start end = do 14 | let diff = end - start 15 | putStrLn $ printf "%s tps" (tps diff iters) 16 | 17 | where 18 | tps :: Double -> Int -> String 19 | tps d i = printf "%.0f" ((realToFrac i) / d) 20 | 21 | -- vim: set ts=4 sw=4 et: 22 | -------------------------------------------------------------------------------- /src/Data/RingBuffer/SequenceBarrier.hs: -------------------------------------------------------------------------------- 1 | module Data.RingBuffer.SequenceBarrier 2 | ( SequenceBarrier (..) 3 | , waitFor 4 | ) 5 | where 6 | 7 | import Control.Concurrent (yield) 8 | import Data.RingBuffer.Sequence 9 | import Data.RingBuffer.Sequencer 10 | 11 | 12 | data SequenceBarrier s 13 | = SequenceBarrier !(Sequencer s) 14 | [Sequence] 15 | -- ^ dependent sequences 16 | 17 | 18 | waitFor :: SequenceBarrier s -> Int -> IO Int 19 | waitFor barrier@(SequenceBarrier sqr deps) sq = do 20 | avail <- case deps of 21 | [] -> readSequence (cursor sqr) 22 | xs -> minimumSequence xs maxBound 23 | 24 | if avail >= sq 25 | then highestPublishedSequence sqr sq avail 26 | else yield >> waitFor barrier sq 27 | 28 | -- vim: set ts=4 sw=4 et: 29 | -------------------------------------------------------------------------------- /perf/TChan/Unicast.hs: -------------------------------------------------------------------------------- 1 | module TChan.Unicast (run) where 2 | 3 | import Control.Concurrent 4 | import Control.Concurrent.STM 5 | import Control.Exception (finally) 6 | import Control.Monad (unless) 7 | 8 | import Util 9 | 10 | run :: Int -> IO () 11 | run i = do 12 | chan <- newTChanIO 13 | done <- newEmptyMVar :: IO (MVar ()) 14 | start <- now 15 | 16 | forkIO $ publishTChan chan 0 17 | forkIO $ consumeTChan chan 0 `finally` putMVar done () 18 | 19 | takeMVar done >> now >>= printTiming i start 20 | 21 | where 22 | publishTChan chan i' = unless (i' > i) 23 | $ atomically (writeTChan chan i') >> publishTChan chan (i' + 1) 24 | 25 | consumeTChan chan i' = unless (i' > i) 26 | $ atomically (readTChan chan) >> consumeTChan chan (i' + 1) 27 | 28 | 29 | -- vim: set ts=4 sw=4 et: 30 | -------------------------------------------------------------------------------- /perf/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Criterion.Types 4 | import Criterion.Main (defaultMain) 5 | 6 | import qualified TChan.Multicast 7 | import qualified TChan.Unicast 8 | import qualified Disruptor3.Multicast 9 | import qualified Disruptor3.Unicast 10 | import qualified Disruptor3.Diamond 11 | 12 | 13 | iterations :: Int 14 | iterations = 1000000 15 | 16 | main :: IO () 17 | main = defaultMain 18 | [ bench "TChan.Multicast" . nfIO . TChan.Multicast.run $ iterations 19 | , bench "TChan.Unicast" . nfIO . TChan.Unicast.run $ iterations 20 | , bench "Disruptor3.Unicast" . nfIO . Disruptor3.Unicast.run $ iterations 21 | , bench "Disruptor3.Multicast" . nfIO . Disruptor3.Multicast.run $ iterations 22 | , bench "Disruptor3.Diamond" . nfIO . Disruptor3.Diamond.run $ iterations 23 | ] 24 | -------------------------------------------------------------------------------- /perf/Disruptor3/Unicast.hs: -------------------------------------------------------------------------------- 1 | module Disruptor3.Unicast (run) where 2 | 3 | import Control.Concurrent.STM 4 | import Control.Monad 5 | import Data.IORef 6 | import Data.RingBuffer 7 | import Util 8 | 9 | 10 | run :: Int -> IO () 11 | run i = do 12 | strt <- now 13 | done <- atomically newEmptyTMVar 14 | xs <- newIORef (0 :: Int) 15 | d <- newSingleProducerRingBuffer (1024*8) (newIORef 0) 16 | >>= consumeWith (\ _ -> modifyIORef' xs (+1)) 17 | >>= andThen (readIORef >=> (\ x -> when (x >= i) $ atomically (putTMVar done ()))) 18 | >>= start 19 | 20 | forM_ [0 .. i] $ publish d . flip writeIORef 21 | 22 | atomically $ takeTMVar done 23 | stop d 24 | 25 | nxs <- readIORef xs 26 | when (nxs /= (i + 1)) $ 27 | error $ "expected " ++ show (i + 1) ++ " consumed entries, got: " ++ show nxs 28 | 29 | now >>= printTiming i strt 30 | 31 | -- vim: set ts=4 sw=4 et: 32 | -------------------------------------------------------------------------------- /perf/TChan/Multicast.hs: -------------------------------------------------------------------------------- 1 | module TChan.Multicast (run) where 2 | 3 | import Control.Concurrent 4 | import Control.Concurrent.STM 5 | import Control.Exception (finally) 6 | import Control.Monad (replicateM, unless) 7 | import Util 8 | 9 | 10 | run :: Int -> IO () 11 | run i = do 12 | chans <- replicateM 3 newTChanIO 13 | dones <- replicateM 3 newEmptyMVar 14 | start <- now 15 | 16 | forkIO $ publishTChan chans 0 17 | mapM_ (\(ch,lck) -> forkChild ch lck) $ zip chans dones 18 | 19 | mapM_ takeMVar dones 20 | now >>= printTiming i start 21 | 22 | where 23 | publishTChan chans i' = unless (i' > i) $ do 24 | mapM_ (\chan -> atomically (writeTChan chan i')) chans 25 | publishTChan chans (i' + 1) 26 | 27 | consumeTChan chan i' = unless (i' > i) $ 28 | atomically (readTChan chan) >> consumeTChan chan (i' + 1) 29 | 30 | forkChild chan lck = forkIO $ 31 | consumeTChan chan 0 `finally` putMVar lck () 32 | 33 | 34 | -- vim: set ts=4 sw=4 et: 35 | -------------------------------------------------------------------------------- /src/Data/RingBuffer/Sequencer/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | 3 | module Data.RingBuffer.Sequencer.Internal 4 | ( ceilNextPowerOfTwo 5 | , log2 6 | ) 7 | where 8 | 9 | import Data.Bits 10 | 11 | 12 | ceilNextPowerOfTwo :: Int -> Int 13 | ceilNextPowerOfTwo i = shiftL 1 (32 - numberOfLeadingZeros (i - 1)) 14 | {-# INLINABLE ceilNextPowerOfTwo #-} 15 | 16 | numberOfLeadingZeros :: Int -> Int 17 | numberOfLeadingZeros i = nlz i 1 18 | where 19 | nlz 0 _ = 32 20 | nlz i' n | shiftR i' 16 == 0 = nlz (shiftL i' 16) (n + 16) 21 | | shiftR i' 24 == 0 = nlz (shiftL i' 8) (n + 8) 22 | | shiftR i' 28 == 0 = nlz (shiftL i' 4) (n + 4) 23 | | shiftR i' 30 == 0 = nlz (shiftL i' 2) (n + 2) 24 | | otherwise = n - shiftR i' 31 25 | 26 | log2 :: Int -> Int 27 | log2 = loop 0 28 | where 29 | loop !r i = let i' = shiftR i 1 30 | in if i' == 0 then r else loop (r+1) i' 31 | {-# INLINABLE log2 #-} 32 | 33 | 34 | -- vim: set ts=4 sw=4 et: 35 | -------------------------------------------------------------------------------- /perf/Disruptor3/Multicast.hs: -------------------------------------------------------------------------------- 1 | module Disruptor3.Multicast (run) where 2 | 3 | import Control.Concurrent.STM 4 | import Control.Monad 5 | import Data.IORef 6 | import Data.RingBuffer 7 | import Util 8 | 9 | 10 | run :: Int -> IO () 11 | run i = do 12 | strt <- now 13 | done <- atomically newEmptyTMVar 14 | xs <- newIORef (0 :: Int) 15 | ys <- newIORef (0 :: Int) 16 | zs <- newIORef (0 :: Int) 17 | d <- newSingleProducerRingBuffer (1024*8) (newIORef 0) 18 | >>= consumeWith (\ _ -> modifyIORef' xs (+1)) 19 | >>= andAlso (\ _ -> modifyIORef' ys (+1)) 20 | >>= andAlso (\ _ -> modifyIORef' zs (+1)) 21 | >>= andThen (readIORef >=> (\ x -> when (x >= i) $ atomically (putTMVar done ()))) 22 | >>= start 23 | 24 | forM_ [0 .. i] $ publish d . flip writeIORef 25 | 26 | atomically $ takeTMVar done 27 | stop d 28 | 29 | nxs <- readIORef xs 30 | nys <- readIORef ys 31 | nzs <- readIORef zs 32 | when (nxs + nys + nzs /= (i + 1) * 3) $ 33 | error $ "expected " ++ show ((i + 1) * 3) ++ " consumed entries, got: " 34 | ++ show (nxs + nys + nzs) 35 | 36 | now >>= printTiming i strt 37 | 38 | -- vim: set ts=4 sw=4 et:e 39 | -------------------------------------------------------------------------------- /perf/Disruptor3/Diamond.hs: -------------------------------------------------------------------------------- 1 | module Disruptor3.Diamond (run) where 2 | 3 | import Control.Applicative 4 | import Control.Concurrent.STM 5 | import Control.Monad 6 | import Data.IORef 7 | import Data.RingBuffer 8 | import Util 9 | 10 | 11 | data FizzBuzz = FizzBuzz 12 | { fizz :: IORef Bool 13 | , buzz :: IORef Bool 14 | , pub :: IORef Int 15 | } 16 | 17 | run :: Int -> IO () 18 | run i = do 19 | strt <- now 20 | done <- atomically newEmptyTMVar 21 | count <- newIORef (0 :: Int) 22 | d <- newSingleProducerRingBuffer (1024*8) (FizzBuzz <$> newIORef False <*> newIORef False <*> newIORef 0) 23 | >>= consumeWith (\ (FizzBuzz f _ _) -> writeIORef f True) 24 | >>= andAlso (\ (FizzBuzz _ b _) -> writeIORef b True) 25 | >>= andThen (\ (FizzBuzz f b _) -> do 26 | f' <- readIORef f 27 | b' <- readIORef b 28 | when (f' && b') $ 29 | modifyIORef' count (+1)) 30 | >>= andThen (readIORef . pub >=> (\ x -> when (x >= i) $ atomically (putTMVar done ()))) 31 | >>= start 32 | 33 | forM_ [0 .. i] $ \ i' -> 34 | publish d (flip writeIORef i' . pub) 35 | 36 | atomically $ takeTMVar done 37 | stop d 38 | 39 | fizzbuzzes <- readIORef count 40 | when (fizzbuzzes /= i + 1) $ 41 | error $ "expected " ++ show (i + 1) ++ " consumed entries, got: " ++ show fizzbuzzes 42 | 43 | now >>= printTiming i strt 44 | 45 | -- vim: set ts=4 sw=4 et:e 46 | -------------------------------------------------------------------------------- /src/Data/RingBuffer/RingBuffer.hs: -------------------------------------------------------------------------------- 1 | module Data.RingBuffer.RingBuffer 2 | ( RingBuffer 3 | , mkRingBuffer 4 | , sequencer 5 | , addGates 6 | , publish 7 | , publishMany 8 | , elemAt 9 | ) 10 | where 11 | 12 | import Data.Bits 13 | import Data.Foldable (forM_) 14 | import Data.RingBuffer.Sequence (Sequence) 15 | import Data.RingBuffer.Sequencer (Sequencer, bufferSize) 16 | import qualified Data.RingBuffer.Sequencer as S 17 | import Data.Vector (Vector, unsafeIndex) 18 | import qualified Data.Vector as V 19 | 20 | 21 | data RingBuffer a s 22 | = RingBuffer !Int 23 | -- ^ index mask 24 | !(Vector a) 25 | -- ^ entries 26 | !(Sequencer s) 27 | 28 | mkRingBuffer :: Sequencer s -> IO a -> IO (RingBuffer a s) 29 | mkRingBuffer sqr fill = do 30 | vs <- V.replicateM (bufferSize sqr) fill 31 | return $ RingBuffer (bufferSize sqr - 1) vs sqr 32 | 33 | sequencer :: RingBuffer a s -> Sequencer s 34 | sequencer (RingBuffer _ _ s) = s 35 | {-# INLINABLE sequencer #-} 36 | 37 | addGates :: RingBuffer a s -> [Sequence] -> RingBuffer a s 38 | addGates (RingBuffer msk vs sqr) = RingBuffer msk vs . S.addGates sqr 39 | 40 | publish :: RingBuffer a s -> (a -> IO ()) -> IO () 41 | publish (RingBuffer msk vs sqr) update = do 42 | next <- S.next sqr 1 43 | update $ vs `unsafeIndex` (next .&. msk) 44 | S.publish sqr next 45 | 46 | publishMany :: RingBuffer a s -> Int -> (a -> IO ()) -> IO () 47 | publishMany (RingBuffer msk vs sqr) n update = do 48 | next <- S.next sqr n 49 | forM_ [next - n - 1 .. next] $ \ i -> 50 | update $ vs `unsafeIndex` (i .&. msk) 51 | S.publishRange sqr (next - n - 1) next 52 | 53 | elemAt :: RingBuffer a s -> Int -> a 54 | elemAt (RingBuffer msk vs _) i = vs `unsafeIndex` (i .&. msk) 55 | {-# INLINABLE elemAt #-} 56 | 57 | 58 | -- vim: set ts=4 sw=4 et: 59 | -------------------------------------------------------------------------------- /src/Data/RingBuffer/Sequence.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE MagicHash #-} 4 | {-# LANGUAGE UnboxedTuples #-} 5 | 6 | module Data.RingBuffer.Sequence 7 | ( Sequence 8 | , mkSequence 9 | , readSequence 10 | , writeSequence 11 | , casSequence 12 | , minimumSequence 13 | ) 14 | where 15 | 16 | import Data.Atomics.Internal 17 | import Data.List (foldl') 18 | #if MIN_VERSION_base(4,7,0) 19 | import GHC.Base hiding ((==#)) 20 | import qualified GHC.PrimopWrappers as GPW 21 | #else 22 | import GHC.Base 23 | #endif 24 | 25 | -- GHC 7.8 changed some primops 26 | #if MIN_VERSION_base(4,7,0) 27 | (==#) :: Int# -> Int# -> Bool 28 | (==#) x y = case x GPW.==# y of { 0# -> False; _ -> True } 29 | #endif 30 | 31 | #include "MachDeps.h" 32 | #ifndef SIZEOF_HSINT 33 | #define SIZEOF_HSINT INT_SIZE_IN_BYTES 34 | #endif 35 | 36 | 37 | data Sequence = Sequence (MutableByteArray# RealWorld) 38 | 39 | 40 | mkSequence :: IO Sequence 41 | mkSequence = do 42 | raw <- mkRaw 43 | writeSequence raw (-1) 44 | return raw 45 | {-# INLINABLE mkSequence #-} 46 | 47 | mkRaw :: IO Sequence 48 | mkRaw = IO $ \ s -> 49 | case newPinnedByteArray# size s of 50 | (# s', arr #) -> (# s', Sequence arr #) 51 | where 52 | !(I# size) = SIZEOF_HSINT * 15 53 | {-# INLINABLE mkRaw #-} 54 | 55 | readSequence :: Sequence -> IO Int 56 | readSequence (Sequence arr) = IO $ \ s -> 57 | case readIntArray# arr 7# s of 58 | (# s', i #) -> (# s', I# i #) 59 | {-# INLINABLE readSequence #-} 60 | 61 | writeSequence :: Sequence -> Int -> IO () 62 | writeSequence (Sequence arr) (I# i) = IO $ \ s -> 63 | case writeIntArray# arr 7# i s of 64 | s' -> (# s', () #) 65 | {-# INLINABLE writeSequence #-} 66 | 67 | casSequence :: Sequence -> Int -> Int -> IO Bool 68 | casSequence (Sequence arr#) (I# old#) (I# new#) = IO $ \ s1# -> 69 | let (# s2#, res# #) = casIntArray# arr# 7# old# new# s1# 70 | in case res# ==# old# of 71 | False -> (# s2#, False #) 72 | True -> (# s2#, True #) 73 | {-# INLINABLE casSequence #-} 74 | 75 | minimumSequence :: [Sequence] -> Int -> IO Int 76 | minimumSequence [] def = return def 77 | minimumSequence ss def = return . foldl' min def =<< mapM readSequence ss 78 | {-# INLINABLE minimumSequence #-} 79 | 80 | 81 | -- vim: set ts=4 sw=4 et: 82 | -------------------------------------------------------------------------------- /data-ringbuffer.cabal: -------------------------------------------------------------------------------- 1 | name: data-ringbuffer 2 | version: 0.3 3 | synopsis: Ringbuffer implementation using Vectors, inspired by the "Disruptor Pattern" 4 | homepage: https://github.com/kim/data-ringbuffer 5 | license: OtherLicense 6 | license-file: LICENSE 7 | author: Kim Altintop 8 | maintainer: kim.altintop@gmail.com 9 | category: Data, Concurrency 10 | build-type: Simple 11 | stability: Experimental 12 | cabal-version: >=1.10 13 | 14 | extra-source-files: Readme.md 15 | 16 | source-repository head 17 | type: git 18 | location: git://github.com/kim/data-ringbuffer.git 19 | 20 | library 21 | exposed-modules: Data.RingBuffer 22 | , Data.RingBuffer.RingBuffer 23 | , Data.RingBuffer.Sequence 24 | , Data.RingBuffer.SequenceBarrier 25 | , Data.RingBuffer.Sequencer 26 | , Data.RingBuffer.Sequencer.Internal 27 | , Data.RingBuffer.Sequencer.MultiProducer 28 | , Data.RingBuffer.Sequencer.SingleProducer 29 | build-depends: base >= 4 && < 5 30 | , atomic-primops 31 | , exceptions 32 | , ghc-prim 33 | , primitive 34 | , stm 35 | , transformers 36 | , vector 37 | default-language: Haskell2010 38 | ghc-options: -Wall 39 | -O2 40 | -funbox-strict-fields 41 | ghc-prof-options: -fprof-auto 42 | hs-source-dirs: src 43 | 44 | 45 | benchmark perf-data-ringbuffer 46 | type: exitcode-stdio-1.0 47 | main-is: Main.hs 48 | build-depends: base >= 4 && < 5 49 | , atomic-primops 50 | , criterion 51 | , data-ringbuffer 52 | , deepseq 53 | , stm 54 | , time 55 | , vector 56 | default-language: Haskell2010 57 | ghc-options: -Wall 58 | -O2 59 | -threaded 60 | -rtsopts 61 | "-with-rtsopts=-N -I0" 62 | -funbox-strict-fields 63 | ghc-prof-options: -fprof-auto 64 | hs-source-dirs: perf, perf/Disruptor3, perf/TChan 65 | -------------------------------------------------------------------------------- /src/Data/RingBuffer/Sequencer/SingleProducer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | 3 | module Data.RingBuffer.Sequencer.SingleProducer 4 | ( Sequencer (..) 5 | , mkSequencer 6 | , bufferSize 7 | , cursor 8 | , addGates 9 | , next 10 | , publish 11 | , publishRange 12 | , isAvailable 13 | , highestPublishedSequence 14 | ) 15 | where 16 | 17 | import Control.Concurrent (yield) 18 | import Control.Monad (liftM, when) 19 | import Data.RingBuffer.Sequence 20 | import Data.RingBuffer.Sequencer.Internal 21 | 22 | 23 | data Sequencer 24 | = Sequencer !Sequence 25 | -- ^ cursor 26 | !Int 27 | -- ^ buffer size 28 | [Sequence] 29 | -- ^ "gating" sequences 30 | !Sequence 31 | -- ^ next value 32 | !Sequence 33 | -- ^ cached value 34 | 35 | 36 | mkSequencer :: Int -> [Sequence] -> IO Sequencer 37 | mkSequencer size gating = do 38 | sq <- mkSequence 39 | nxt <- mkSequence 40 | chd <- mkSequence 41 | return $ Sequencer sq size' gating nxt chd 42 | where 43 | size' = ceilNextPowerOfTwo size 44 | 45 | bufferSize :: Sequencer -> Int 46 | bufferSize (Sequencer _ s _ _ _) = s 47 | {-# INLINABLE bufferSize #-} 48 | 49 | cursor :: Sequencer -> Sequence 50 | cursor (Sequencer c _ _ _ _) = c 51 | {-# INLINABLE cursor #-} 52 | 53 | addGates :: Sequencer -> [Sequence] -> Sequencer 54 | addGates (Sequencer sq siz gates nxt cache) gates' = 55 | Sequencer sq siz (gates ++ gates') nxt cache 56 | {-# INLINABLE addGates #-} 57 | 58 | next :: Sequencer -> Int -> IO Int 59 | next (Sequencer _ s gs nxt cache) n = {-# SCC "next" #-} do 60 | nextValue <- readSequence nxt 61 | gate <- readSequence cache 62 | 63 | let nextSequence = nextValue + n 64 | wrap = nextSequence - s 65 | 66 | when (wrap > gate || gate > nextValue) $ 67 | loop wrap (minimumSequence gs nextValue) 68 | 69 | writeSequence nxt nextSequence 70 | 71 | return nextSequence 72 | where 73 | loop !wrap m = {-# SCC "next.loop" #-} do 74 | minsq <- m 75 | if wrap > minsq 76 | then do 77 | {-# SCC "next.loop.yield" #-} yield 78 | loop wrap m 79 | else 80 | writeSequence cache minsq 81 | {-# INLINABLE next #-} 82 | 83 | publish :: Sequencer -> Int -> IO () 84 | publish (Sequencer c _ _ _ _) = writeSequence c 85 | {-# INLINABLE publish #-} 86 | 87 | publishRange :: Sequencer -> Int -> Int -> IO () 88 | publishRange s _ = publish s 89 | {-# INLINABLE publishRange #-} 90 | 91 | isAvailable :: Sequencer -> Int -> IO Bool 92 | isAvailable (Sequencer c _ _ _ _) s = (s <=) `liftM` readSequence c 93 | {-# INLINABLE isAvailable #-} 94 | 95 | highestPublishedSequence :: Sequencer -> Int -> Int -> IO Int 96 | highestPublishedSequence _ _ = return -- orly?! 97 | {-# INLINABLE highestPublishedSequence #-} 98 | 99 | 100 | -- vim: set ts=4 sw=4 et: 101 | -------------------------------------------------------------------------------- /src/Data/RingBuffer/Sequencer/MultiProducer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | 3 | module Data.RingBuffer.Sequencer.MultiProducer 4 | ( Sequencer (..) 5 | , mkSequencer 6 | , bufferSize 7 | , cursor 8 | , addGates 9 | , next 10 | , publish 11 | , publishRange 12 | , isAvailable 13 | , highestPublishedSequence 14 | ) 15 | where 16 | 17 | import Control.Concurrent (yield) 18 | import Control.Monad (liftM) 19 | import Data.Bits hiding (shift) 20 | import Data.RingBuffer.Sequence 21 | import Data.RingBuffer.Sequencer.Internal 22 | import qualified Data.Vector.Unboxed.Mutable as MV 23 | 24 | 25 | data Sequencer 26 | = Sequencer !Sequence 27 | -- ^ cursor 28 | !Int 29 | -- ^ buffer size 30 | [Sequence] 31 | -- ^ "gating" sequences tracking concurrent producers 32 | !Sequence 33 | -- ^ min sequence cache 34 | (MV.IOVector Int) 35 | -- ^ available buffer 36 | !Int 37 | -- ^ mask 38 | !Int 39 | -- ^ shift 40 | 41 | 42 | mkSequencer :: Int -> [Sequence] -> IO Sequencer 43 | mkSequencer size gating = do 44 | sq <- mkSequence 45 | mn <- mkSequence 46 | ab <- MV.replicate size' (-1) 47 | return $ Sequencer sq size' gating mn ab (size' - 1) (log2 size') 48 | where 49 | size' = ceilNextPowerOfTwo size 50 | 51 | bufferSize :: Sequencer -> Int 52 | bufferSize (Sequencer _ s _ _ _ _ _) = s 53 | {-# INLINABLE bufferSize #-} 54 | 55 | cursor :: Sequencer -> Sequence 56 | cursor (Sequencer c _ _ _ _ _ _) = c 57 | {-# INLINABLE cursor #-} 58 | 59 | addGates :: Sequencer -> [Sequence] -> Sequencer 60 | addGates (Sequencer sq siz gates cache ab msk shft) gates' = 61 | Sequencer sq siz (gates ++ gates') cache ab msk shft 62 | 63 | next :: Sequencer -> Int -> IO Int 64 | next sq@(Sequencer c s gs mcache _ _ _) n = do 65 | curr <- readSequence c 66 | 67 | let nxt = curr + n 68 | wrap = nxt - s 69 | 70 | mingate <- readSequence mcache 71 | 72 | if wrap > mingate || mingate > curr 73 | then do 74 | mingate' <- minimumSequence gs curr 75 | if wrap > mingate' 76 | then do 77 | yield 78 | next sq n 79 | else do 80 | writeSequence mcache mingate' 81 | next sq n 82 | else do 83 | cas'd <- casSequence c curr nxt 84 | if cas'd 85 | then return nxt 86 | else next sq n 87 | 88 | publish :: Sequencer -> Int -> IO () 89 | publish = setAvailable 90 | {-# INLINABLE publish #-} 91 | 92 | publishRange :: Sequencer -> Int -> Int -> IO () 93 | publishRange s lo !hi = go lo 94 | where 95 | go !i | i <= hi = setAvailable s i >> go (i+i) 96 | | otherwise = return () 97 | {-# INLINABLE publishRange #-} 98 | 99 | isAvailable :: Sequencer -> Int -> IO Bool 100 | isAvailable (Sequencer _ _ _ _ avail mask shift) sq = 101 | (== shiftR sq shift) `liftM` MV.unsafeRead avail (sq .&. mask) 102 | {-# INLINABLE isAvailable #-} 103 | 104 | highestPublishedSequence :: Sequencer -> Int -> Int -> IO Int 105 | highestPublishedSequence _ !lo !hi | lo > hi = error "invalid lower bound" 106 | highestPublishedSequence s !lo !hi = go lo 107 | where 108 | go i | i <= hi = do 109 | avail <- isAvailable s i 110 | if not avail then return (i - 1) else go (i+1) 111 | | otherwise = return hi 112 | 113 | 114 | -------------------------------------------------------------------------------- 115 | -- internal 116 | -------------------------------------------------------------------------------- 117 | 118 | setAvailable :: Sequencer -> Int -> IO () 119 | setAvailable (Sequencer _ _ _ _ avail mask shift) sq = 120 | MV.unsafeWrite avail (sq .&. mask) (shiftR sq shift) 121 | 122 | -- vim: set ts=4 sw=4 et: 123 | -------------------------------------------------------------------------------- /src/Data/RingBuffer/Sequencer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | 3 | module Data.RingBuffer.Sequencer 4 | ( Sequencer 5 | , SingleProducer 6 | , MultiProducer 7 | , mkMultiProducerSequencer 8 | , mkSingleProducerSequencer 9 | , bufferSize 10 | , cursor 11 | , addGates 12 | , next 13 | , publish 14 | , publishRange 15 | , isAvailable 16 | , highestPublishedSequence 17 | ) 18 | where 19 | 20 | import Control.Monad (liftM) 21 | import Data.RingBuffer.Sequence 22 | import qualified Data.RingBuffer.Sequencer.MultiProducer as Multi 23 | import qualified Data.RingBuffer.Sequencer.SingleProducer as Single 24 | 25 | 26 | type SingleProducer = Single.Sequencer 27 | type MultiProducer = Multi.Sequencer 28 | 29 | data Sequencer a where 30 | MultiProducerSequencer :: Multi.Sequencer -> Sequencer MultiProducer 31 | SingleProducerSequencer :: Single.Sequencer -> Sequencer SingleProducer 32 | 33 | 34 | mkMultiProducerSequencer :: Int -> [Sequence] -> IO (Sequencer Multi.Sequencer) 35 | mkMultiProducerSequencer size = liftM MultiProducerSequencer . Multi.mkSequencer size 36 | 37 | mkSingleProducerSequencer :: Int -> [Sequence] -> IO (Sequencer Single.Sequencer) 38 | mkSingleProducerSequencer size = liftM SingleProducerSequencer . Single.mkSequencer size 39 | 40 | bufferSize :: Sequencer a -> Int 41 | bufferSize (SingleProducerSequencer s) = Single.bufferSize s 42 | bufferSize (MultiProducerSequencer s) = Multi.bufferSize s 43 | {-# SPECIALISE INLINE bufferSize :: Sequencer SingleProducer -> Int #-} 44 | {-# SPECIALISE INLINE bufferSize :: Sequencer MultiProducer -> Int #-} 45 | 46 | cursor :: Sequencer a -> Sequence 47 | cursor (SingleProducerSequencer s) = Single.cursor s 48 | cursor (MultiProducerSequencer s) = Multi.cursor s 49 | {-# SPECIALISE INLINE cursor :: Sequencer SingleProducer -> Sequence #-} 50 | {-# SPECIALISE INLINE cursor :: Sequencer MultiProducer -> Sequence #-} 51 | 52 | addGates :: Sequencer a -> [Sequence] -> Sequencer a 53 | addGates (SingleProducerSequencer s) = SingleProducerSequencer . Single.addGates s 54 | addGates (MultiProducerSequencer s) = MultiProducerSequencer . Multi.addGates s 55 | {-# SPECIALISE INLINE addGates :: Sequencer SingleProducer -> [Sequence] -> Sequencer SingleProducer #-} 56 | {-# SPECIALISE INLINE addGates :: Sequencer MultiProducer -> [Sequence] -> Sequencer MultiProducer #-} 57 | 58 | next :: Sequencer a -> Int -> IO Int 59 | next (SingleProducerSequencer s) = Single.next s 60 | next (MultiProducerSequencer s) = Multi.next s 61 | {-# SPECIALISE INLINE next :: Sequencer SingleProducer -> Int -> IO Int #-} 62 | {-# SPECIALISE INLINE next :: Sequencer MultiProducer -> Int -> IO Int #-} 63 | 64 | publish :: Sequencer a -> Int -> IO () 65 | publish (SingleProducerSequencer s) = Single.publish s 66 | publish (MultiProducerSequencer s) = Multi.publish s 67 | {-# SPECIALISE INLINE publish :: Sequencer SingleProducer -> Int -> IO () #-} 68 | {-# SPECIALISE INLINE publish :: Sequencer MultiProducer -> Int -> IO () #-} 69 | 70 | publishRange :: Sequencer a -> Int -> Int -> IO () 71 | publishRange (SingleProducerSequencer s) = Single.publishRange s 72 | publishRange (MultiProducerSequencer s) = Multi.publishRange s 73 | {-# SPECIALISE INLINE publishRange :: Sequencer SingleProducer -> Int -> Int -> IO () #-} 74 | {-# SPECIALISE INLINE publishRange :: Sequencer MultiProducer -> Int -> Int -> IO () #-} 75 | 76 | isAvailable :: Sequencer a -> Int -> IO Bool 77 | isAvailable (SingleProducerSequencer s) = Single.isAvailable s 78 | isAvailable (MultiProducerSequencer s) = Multi.isAvailable s 79 | {-# SPECIALISE INLINE isAvailable :: Sequencer SingleProducer -> Int -> IO Bool #-} 80 | {-# SPECIALISE INLINE isAvailable :: Sequencer MultiProducer -> Int -> IO Bool #-} 81 | 82 | highestPublishedSequence :: Sequencer a -> Int -> Int -> IO Int 83 | highestPublishedSequence (SingleProducerSequencer s) = Single.highestPublishedSequence s 84 | highestPublishedSequence (MultiProducerSequencer s) = Multi.highestPublishedSequence s 85 | {-# SPECIALISE INLINE highestPublishedSequence :: Sequencer SingleProducer -> Int -> Int -> IO Int #-} 86 | {-# SPECIALISE INLINE highestPublishedSequence :: Sequencer MultiProducer -> Int -> Int -> IO Int #-} 87 | -------------------------------------------------------------------------------- /src/Data/RingBuffer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | 3 | module Data.RingBuffer 4 | ( newMultiProducerRingBuffer 5 | , newSingleProducerRingBuffer 6 | , consumeWith 7 | , andAlso 8 | , andThen 9 | , start 10 | , stop 11 | , publish 12 | , publishMany 13 | ) 14 | where 15 | 16 | import Control.Concurrent 17 | import Control.Monad (forM_, liftM, when) 18 | import Control.Monad.Catch (finally) 19 | import Data.IORef 20 | import Data.RingBuffer.RingBuffer (RingBuffer, elemAt, 21 | mkRingBuffer) 22 | import qualified Data.RingBuffer.RingBuffer as RB 23 | import Data.RingBuffer.Sequence 24 | import Data.RingBuffer.SequenceBarrier 25 | import Data.RingBuffer.Sequencer ( SingleProducer 26 | , MultiProducer 27 | , mkMultiProducerSequencer 28 | , mkSingleProducerSequencer 29 | ) 30 | 31 | 32 | data Consumer m a s 33 | = Consumer (a -> IO ()) 34 | -- ^ event processing action 35 | !Sequence 36 | -- ^ tracks which events were consumed by this 'Consumer' 37 | !(SequenceBarrier s) 38 | -- ^ barrier tracking producers and/or prerequisite handlers 39 | 40 | data ConsumerGroup m a s = ConsumerGroup 41 | { rb :: RingBuffer a s 42 | , pr :: Maybe (ConsumerGroup m a s) 43 | , hs :: [Consumer m a s] 44 | } 45 | 46 | data Disruptor a s = Disruptor (RingBuffer a s) [ThreadId] (IORef Bool) 47 | 48 | 49 | newMultiProducerRingBuffer :: Int -> IO a -> IO (RingBuffer a MultiProducer) 50 | newMultiProducerRingBuffer siz fill = do 51 | sqr <- mkMultiProducerSequencer siz [] 52 | mkRingBuffer sqr fill 53 | 54 | newSingleProducerRingBuffer :: Int -> IO a -> IO (RingBuffer a SingleProducer) 55 | newSingleProducerRingBuffer siz fill = do 56 | sqr <- mkSingleProducerSequencer siz [] 57 | mkRingBuffer sqr fill 58 | 59 | consumeWith :: (a -> IO ()) -> RingBuffer a s -> IO (ConsumerGroup m a s) 60 | consumeWith f b = do 61 | h <- mkConsumer b f [] 62 | return $ ConsumerGroup b Nothing [h] 63 | 64 | andAlso :: (a -> IO ()) -> ConsumerGroup m a s -> IO (ConsumerGroup m a s) 65 | andAlso f cg@ConsumerGroup{..} = do 66 | h <- mkConsumer rb f [] 67 | return cg { hs = h : hs } 68 | 69 | andThen :: (a -> IO ()) -> ConsumerGroup m a s -> IO (ConsumerGroup m a s) 70 | andThen f cg@ConsumerGroup{..} = do 71 | h <- mkConsumer rb f (map consumerSequence hs) 72 | return cg { hs = [h], pr = Just cg } 73 | 74 | 75 | start :: ConsumerGroup m a s -> IO (Disruptor a s) 76 | start cg@ConsumerGroup{..} = do 77 | let rb' = RB.addGates rb (map consumerSequence hs) 78 | tids <- startConsumers cg { rb = rb' } 79 | running <- newIORef True 80 | return $ Disruptor rb' tids running 81 | where 82 | startConsumers (ConsumerGroup rb' Nothing cs) = mapM (run rb') cs 83 | startConsumers (ConsumerGroup rb' (Just prev) cs) = do 84 | t1 <- startConsumers prev { rb = rb' } 85 | t2 <- startConsumers $ ConsumerGroup rb' Nothing cs 86 | return $ t1 ++ t2 87 | 88 | stop :: Disruptor a s -> IO () 89 | stop (Disruptor _ tids ref) = do 90 | running <- atomicModifyIORef ref ((,) False) 91 | when running $ 92 | mapM_ killThread tids 93 | 94 | publish :: Disruptor a s -> (a -> IO ()) -> IO () 95 | publish (Disruptor rb _ _) = RB.publish rb 96 | 97 | publishMany :: Disruptor a s -> Int -> (a -> IO ()) -> IO () 98 | publishMany (Disruptor rb _ _) = RB.publishMany rb 99 | 100 | 101 | -------------------------------------------------------------------------------- 102 | -- internal 103 | -------------------------------------------------------------------------------- 104 | 105 | mkConsumer :: RingBuffer a s -> (a -> IO ()) -> [Sequence] -> IO (Consumer m a s) 106 | mkConsumer b f deps = do 107 | sq <- mkSequence 108 | return $ Consumer f sq (SequenceBarrier (RB.sequencer b) deps) 109 | 110 | consumerSequence :: Consumer m a s -> Sequence 111 | consumerSequence (Consumer _ s _) = s 112 | 113 | run :: RingBuffer a s -> Consumer m a s -> IO ThreadId 114 | run buf (Consumer f sq bar) = forkIO loop 115 | where 116 | loop = do 117 | next <- (+1) `liftM` readSequence sq 118 | avail <- waitFor bar next 119 | 120 | forM_ [next .. avail] (f . (buf `elemAt`)) 121 | `finally` writeSequence sq avail 122 | loop 123 | 124 | -- vim: set ts=4 sw=4 et: 125 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | 204 | 205 | THIRD-PARTY DEPENDENCIES 206 | ======================== 207 | Convenience copies of some third-party dependencies are distributed with 208 | Apache Cassandra as Java jar files in lib/. Licensing information for 209 | these files can be found in the lib/licenses directory. 210 | --------------------------------------------------------------------------------