Commit 41b5c85a authored by Iustin Pop's avatar Iustin Pop

Precompute allocation nodes

Instead of re-generating the allocation nodes at each step, we only do
it once before calling the allocation routines, and then reuse
them. While this provides just a small speedup (~3%), it's worth doing
as it also reduces the GC cost.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 0d66ea67
...@@ -838,23 +838,23 @@ tryMGEvac _ nl il ex_ndx = ...@@ -838,23 +838,23 @@ tryMGEvac _ nl il ex_ndx =
iterateAlloc :: Node.List iterateAlloc :: Node.List
-> Instance.List -> Instance.List
-> Instance.Instance -> Instance.Instance
-> Int -> AllocNodes
-> [Instance.Instance] -> [Instance.Instance]
-> [CStats] -> [CStats]
-> Result AllocResult -> Result AllocResult
iterateAlloc nl il newinst nreq ixes cstats = iterateAlloc nl il newinst allocnodes ixes cstats =
let depth = length ixes let depth = length ixes
newname = printf "new-%d" depth::String newname = printf "new-%d" depth::String
newidx = length (Container.elems il) + depth newidx = length (Container.elems il) + depth
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
in case genAllocNodes nl nreq >>= tryAlloc nl il newi2 of in case tryAlloc nl il newi2 allocnodes of
Bad s -> Bad s Bad s -> Bad s
Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) -> Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
case sols3 of case sols3 of
[] -> Ok (collapseFailures errs, nl, il, ixes, cstats) [] -> Ok (collapseFailures errs, nl, il, ixes, cstats)
(xnl, xi, _, _):[] -> (xnl, xi, _, _):[] ->
iterateAlloc xnl (Container.add newidx xi il) iterateAlloc xnl (Container.add newidx xi il)
newinst nreq (xi:ixes) newinst allocnodes (xi:ixes)
(totalResources xnl:cstats) (totalResources xnl:cstats)
_ -> Bad "Internal error: multiple solutions for single\ _ -> Bad "Internal error: multiple solutions for single\
\ allocation" \ allocation"
...@@ -863,19 +863,19 @@ iterateAlloc nl il newinst nreq ixes cstats = ...@@ -863,19 +863,19 @@ iterateAlloc nl il newinst nreq ixes cstats =
tieredAlloc :: Node.List tieredAlloc :: Node.List
-> Instance.List -> Instance.List
-> Instance.Instance -> Instance.Instance
-> Int -> AllocNodes
-> [Instance.Instance] -> [Instance.Instance]
-> [CStats] -> [CStats]
-> Result AllocResult -> Result AllocResult
tieredAlloc nl il newinst nreq ixes cstats = tieredAlloc nl il newinst allocnodes ixes cstats =
case iterateAlloc nl il newinst nreq ixes cstats of case iterateAlloc nl il newinst allocnodes ixes cstats of
Bad s -> Bad s Bad s -> Bad s
Ok (errs, nl', il', ixes', cstats') -> Ok (errs, nl', il', ixes', cstats') ->
case Instance.shrinkByType newinst . fst . last $ case Instance.shrinkByType newinst . fst . last $
sortBy (comparing snd) errs of sortBy (comparing snd) errs of
Bad _ -> Ok (errs, nl', il', ixes', cstats') Bad _ -> Ok (errs, nl', il', ixes', cstats')
Ok newinst' -> Ok newinst' ->
tieredAlloc nl' il' newinst' nreq ixes' cstats' tieredAlloc nl' il' newinst' allocnodes ixes' cstats'
-- | Compute the tiered spec string description from a list of -- | Compute the tiered spec string description from a list of
-- allocated instances. -- allocated instances.
......
...@@ -707,7 +707,9 @@ prop_ClusterCanTieredAlloc node inst = ...@@ -707,7 +707,9 @@ prop_ClusterCanTieredAlloc node inst =
==> ==>
let nl = makeSmallCluster node count let nl = makeSmallCluster node count
il = Container.empty il = Container.empty
in case Cluster.tieredAlloc nl il inst rqnodes [] []of allocnodes = Cluster.genAllocNodes nl rqnodes
in case allocnodes >>= \allocnodes' ->
Cluster.tieredAlloc nl il inst allocnodes' [] [] of
Types.Bad _ -> False Types.Bad _ -> False
Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) && Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
IntMap.size il' == length ixes && IntMap.size il' == length ixes &&
...@@ -749,9 +751,10 @@ prop_ClusterAllocBalance node = ...@@ -749,9 +751,10 @@ prop_ClusterAllocBalance node =
let nl = makeSmallCluster node count let nl = makeSmallCluster node count
(hnode, nl') = IntMap.deleteFindMax nl (hnode, nl') = IntMap.deleteFindMax nl
il = Container.empty il = Container.empty
rqnodes = 2 allocnodes = Cluster.genAllocNodes nl' 2
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
in case Cluster.iterateAlloc nl' il i_templ rqnodes [] [] of in case allocnodes >>= \allocnodes' ->
Cluster.iterateAlloc nl' il i_templ allocnodes' [] [] of
Types.Bad _ -> False Types.Bad _ -> False
Types.Ok (_, xnl, il', _, _) -> Types.Ok (_, xnl, il', _, _) ->
let ynl = Container.add (Node.idx hnode) hnode xnl let ynl = Container.add (Node.idx hnode) hnode xnl
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
{- {-
Copyright (C) 2009, 2010 Google Inc. Copyright (C) 2009, 2010, 2011 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -290,6 +290,8 @@ main = do ...@@ -290,6 +290,8 @@ main = do
let reqinst = iofspec ispec let reqinst = iofspec ispec
allocnodes <- exitifbad $ Cluster.genAllocNodes nl req_nodes
-- Run the tiered allocation, if enabled -- Run the tiered allocation, if enabled
(case optTieredSpec opts of (case optTieredSpec opts of
...@@ -299,7 +301,7 @@ main = do ...@@ -299,7 +301,7 @@ main = do
if stop_allocation if stop_allocation
then return result_noalloc then return result_noalloc
else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec) else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
req_nodes [] []) allocnodes [] [])
let spec_map' = Cluster.tieredSpecMap trl_ixes let spec_map' = Cluster.tieredSpecMap trl_ixes
printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
...@@ -319,7 +321,7 @@ main = do ...@@ -319,7 +321,7 @@ main = do
(ereason, fin_nl, fin_il, ixes, _) <- (ereason, fin_nl, fin_il, ixes, _) <-
if stop_allocation if stop_allocation
then return result_noalloc then return result_noalloc
else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [] []) else exitifbad (Cluster.iterateAlloc nl il reqinst allocnodes [] [])
let allocs = length ixes let allocs = length ixes
sreason = reverse $ sortBy (comparing snd) ereason sreason = reverse $ sortBy (comparing snd) ereason
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment