module Sound.SC3.Server.Allocator.BlockAllocator.FirstFit
(
FirstFitAllocator
, Sorting(..)
, Coalescing(..)
, cons
, addressFit
, bestFit
, worstFit
) where
import Control.Arrow (first)
import Control.Failure (Failure, failure)
import Control.Monad (liftM)
import Sound.SC3.Server.Allocator (AllocFailure(..), Id, IdAllocator(..), RangeAllocator(..), Statistics(..))
import Sound.SC3.Server.Allocator.Range (Range)
import qualified Sound.SC3.Server.Allocator.Range as Range
import Sound.SC3.Server.Allocator.BlockAllocator.FreeList (FreeList, Sorting(..))
import qualified Sound.SC3.Server.Allocator.BlockAllocator.FreeList as FreeList
data Coalescing = NoCoalescing | LazyCoalescing deriving (Enum, Eq, Show)
data FirstFitAllocator i = FirstFitAllocator {
coalescing :: Coalescing
, available :: !Int
, used :: !Int
, freeList :: !(FreeList i)
} deriving (Eq, Show)
cons :: Integral i => Sorting -> Coalescing -> Range i -> FirstFitAllocator i
cons s c r = FirstFitAllocator c (fromIntegral (Range.size r)) 0 (FreeList.singleton s r)
addressFit :: Integral i => Coalescing -> Range i -> FirstFitAllocator i
addressFit = cons Address
bestFit :: Integral i => Coalescing -> Range i -> FirstFitAllocator i
bestFit = cons IncreasingSize
worstFit :: Integral i => Coalescing -> Range i -> FirstFitAllocator i
worstFit = cons DecreasingSize
_alloc :: (Integral i, Failure AllocFailure m) => Int -> FirstFitAllocator i -> m (Range i, FirstFitAllocator i)
_alloc n a =
case FreeList.alloc fits (freeList a) of
Nothing -> case coalescing a of
NoCoalescing ->
failure NoFreeIds
LazyCoalescing ->
case FreeList.alloc fits (FreeList.coalesce (freeList a)) of
Nothing -> failure NoFreeIds
Just (r, l) -> alloc r l
Just (r, l) -> alloc r l
where
fits r = Range.size r >= n
alloc r l =
if Range.size r == n
then return (r, a { freeList = l
, used = used a + n })
else let (r1, r2) = Range.split n r
in return (r1, a { freeList = FreeList.insert r2 l
, used = used a + n })
_free :: (Integral i, Failure AllocFailure m) => Range i -> FirstFitAllocator i -> m (FirstFitAllocator i)
_free r a =
let u = used a fromIntegral (Range.size r)
in if u < 0
then failure InvalidId
else return a { freeList = FreeList.insert r (freeList a)
, used = u }
_statistics :: (Integral i) => FirstFitAllocator i -> Statistics
_statistics a =
Statistics {
numAvailable = available a
, numFree = available a used a
, numUsed = used a }
instance (Integral i) => IdAllocator (FirstFitAllocator i) where
type Id (FirstFitAllocator i) = i
alloc = liftM (first Range.begin) . _alloc 1
free = _free . Range.sized 1
statistics = _statistics
instance (Integral i) => RangeAllocator (FirstFitAllocator i) where
allocRange = _alloc
freeRange = _free