kernel/docs/vcpu.lhs

0001 \begin{code}
0002 module VCPU where
0003 import Control.Arrow
0004 import Data.List
0005 import Data.Maybe
0006
0007 type VCPUID = Int
0008 -- (current, runnable, tcur, tprev)
0009 type PCPU = (Maybe VCPUID, [VCPU], Integer, Integer)
0010 -- (id, budget, period, replenishments, activation)
0011 type VCPU = (VCPUID, Integer, Integer, [Replenishment], Integer)
0012 -- (time, budget)
0013 type Replenishment = (Integer, Integer)
0014
0015 cmpId (id1, _, _, _) (id2, _, _, _) = id1 `compare` id2
0016 eqId v1 v2 = cmpId v1 v2 == EQ
0017 pcpuCur (id, _, _, _) = id
0018 findPrio m_id runnable = do
0019   id <- m_id
0020   v  <- find ((== id) . vcpuId) runnable
0021   return $ vcpuT v
0022
0023 cmpPrio (_, _, vT1, _, _) (_, _, vT2, _, _) = vT1 `compare` vT2
0024 vcpuId (id, _, _, _, _) = id
0025 vcpuT (_, _, t, _, _) = t
0026 vcpuBudget (_, b, _, _, _) = b
0027
0028 nextMul vT tcur = tcur + vT - tcur `mod` vT
0029
0030 -- check if changing from 'prev' to 'next' priority causes task with
0031 -- 'prio' to become active
0032 activated _ _ Nothing = False
0033 activated m_prev prio (Just next) = prio >= next && maybe True (> prio) m_prev
0034
0035 schedule :: PCPU -> PCPU
0036 schedule (curId, runnable, tcur, tprev) = (nextId, runnable'', tcur + tdelta', tcur)
0037   where
0038     tdelta = tcur - tprev
0039     prevPrio = findPrio curId runnable
0040
0041     updateRunnable (vid, vb, vT, vR, act)
0042       -- working on current VCPU
0043       | Just vid == curId = (vid, time + curvb', vT, vR', act')
0044       -- working on non-running VCPU
0045       | otherwise         = (vid, time + vb, vT, vR', act')
0046       where
0047         -- accumulate and remove pending replenishments
0048         checkReplenishment (t, b) (repls, time)
0049           | t <= tcur = (repls, time + b)
0050           | otherwise = ((t, b):repls, time)
0051         (vR', time) = foldr checkReplenishment ([], 0) $
0052                         if Just vid == curId
0053                         -- include current replenishment
0054                         then (rt, used):vR
0055                         else vR
0056         act' = if time > 0 then tcur else act
0057         -- budget variables for use if vid is current VCPU
0058         curvb' = max 0 (vb - tdelta)
0059         used = vb - curvb'
0060         -- compute replenishment time
0061         rt = act + vT
0062         -- rt = nextMul vT tcur
0063
0064     runnable' = map updateRunnable runnable
0065
0066     -- pick highest priority VCPU with non-zero budget
0067     (nextId, nextT) = case filter ((> 0) . vcpuBudget) runnable' of
0068                         [] -> (Nothing, 0)
0069                         vs -> ((Just . vcpuId) &&& vcpuT) (minimumBy cmpPrio vs)
0070
0071     -- compute time deltas for higher priority VCPU replenishments,
0072     -- and also its budget if it is the next VCPU to run
0073     vcpuDeltas (vid, vb, vT, vR, act) =
0074       if Just vid == nextId then [vb] else [] ++
0075       if vT <= nextT then map (subtract tcur . fst) vR else []
0076
0077     deltas = concatMap vcpuDeltas runnable'
0078     -- new tdelta is the smallest delta
0079     tdelta' = if null deltas then 1 else minimum deltas
0080
0081     -- set activation times for tasks that became active
0082     nextPrio = const nextT `fmap` nextId
0083     runnable'' = flip map runnable' $ \ (vid, vb, vT, vR, act) ->
0084                    if vb > 0 && activated prevPrio vT nextPrio then
0085                      (vid, vb, vT, vR, tcur)
0086                    else
0087                      (vid, vb, vT, vR, act)
0088
0089
0090 makePCPU :: [(Integer, Integer)] -> PCPU
0091 makePCPU specs = (Nothing, zipWith (\ i (c, t) -> (i, c, t, [], 0)) [0..]
0092                                    specs, 0, 0)
0093
0094 run :: PCPU -> [VCPUID]
0095 run pcpu = concatMap (\ (cur, _, _, _) -> maybeToList cur) $ iterate schedule pcpu
0096
0097 ranFor (_, _, tcur, tprev) = fromIntegral $ tcur - tprev
0098
0099 usage :: Int -> PCPU -> [(Maybe VCPUID, Float)]
0100 usage n pcpu =
0101   map ((pcpuCur . head) &&& ((/ fromIntegral n) . fromIntegral . length))
0102       . groupBy eqId . sortBy cmpId
0103       . take n . concatMap (\ p -> replicate (ranFor p) p) $ iterate schedule pcpu
0104
0105 utilization :: PCPU -> (Double, Double)
0106 utilization (_, runnable, _, _) =
0107   ( sum . map (uncurry (/))
0108         $ map (fromIntegral . vcpuBudget &&& fromIntegral . vcpuT) runnable
0109   , n * (2**(1 / n) - 1) )
0110   where n = fromIntegral $ length runnable
0111
0112 test1 = makePCPU [(1, 5), (1, 6), (1, 7), (1, 8)]
0113 test2 = makePCPU [(1, 5), (1, 6), (1, 7), (1, 25)]
0114 test3 = makePCPU [(1, 4), (1, 4), (1, 4), (1, 4)]
0115 test4 = makePCPU [(1, 3), (1, 4), (1, 5)]
0116 test5 = makePCPU [(1, 3), (1, 4), (2, 5)]
0117 test6 = makePCPU [(1, 2), (1, 3), (1, 4)]
0118 test7 = makePCPU [(1, 5), (1, 5), (1, 5), (1, 5)]
0119 test8 = makePCPU [(1, 4), (2, 5), (3, 10)]
0120 test9 = makePCPU [(10, 200), (20, 50), (49, 200)]
0121
0122 \end{code}