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: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

Ganeti/HTools/Cluster.hs

@@ -838,23 +838,23 @@ tryMGEvac _ nl il ex_ndx =
 iterateAlloc :: Node.List
              -> Instance.List
              -> Instance.Instance
-             -> Int
+             -> AllocNodes
              -> [Instance.Instance]
              -> [CStats]
              -> Result AllocResult
-iterateAlloc nl il newinst nreq ixes cstats =
+iterateAlloc nl il newinst allocnodes ixes cstats =
       let depth = length ixes
           newname = printf "new-%d" depth::String
           newidx = length (Container.elems il) + depth
           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
            Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
                case sols3 of
                  [] -> Ok (collapseFailures errs, nl, il, ixes, cstats)
                  (xnl, xi, _, _):[] ->
                      iterateAlloc xnl (Container.add newidx xi il)
-                                  newinst nreq (xi:ixes)
+                                  newinst allocnodes (xi:ixes)
                                   (totalResources xnl:cstats)
                  _ -> Bad "Internal error: multiple solutions for single\
                           \ allocation"
@@ -863,19 +863,19 @@ iterateAlloc nl il newinst nreq ixes cstats =
 tieredAlloc :: Node.List
             -> Instance.List
             -> Instance.Instance
-            -> Int
+            -> AllocNodes
             -> [Instance.Instance]
             -> [CStats]
             -> Result AllocResult
-tieredAlloc nl il newinst nreq ixes cstats =
-    case iterateAlloc nl il newinst nreq ixes cstats of
+tieredAlloc nl il newinst allocnodes ixes cstats =
+    case iterateAlloc nl il newinst allocnodes ixes cstats of
       Bad s -> Bad s
       Ok (errs, nl', il', ixes', cstats') ->
           case Instance.shrinkByType newinst . fst . last $
                sortBy (comparing snd) errs of
             Bad _ -> Ok (errs, nl', il', ixes', cstats')
             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
 -- allocated instances.

Ganeti/HTools/QC.hs

@@ -707,7 +707,9 @@ prop_ClusterCanTieredAlloc node inst =
             ==>
     let nl = makeSmallCluster node count
         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.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
                                       IntMap.size il' == length ixes &&
@@ -749,9 +751,10 @@ prop_ClusterAllocBalance node =
     let nl = makeSmallCluster node count
         (hnode, nl') = IntMap.deleteFindMax nl
         il = Container.empty
-        rqnodes = 2
+        allocnodes = Cluster.genAllocNodes nl' 2
         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.Ok (_, xnl, il', _, _) ->
                    let ynl = Container.add (Node.idx hnode) hnode xnl

hspace.hs

@@ -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
 it under the terms of the GNU General Public License as published by
@@ -290,6 +290,8 @@ main = do
 
   let reqinst = iofspec ispec
 
+  allocnodes <- exitifbad $ Cluster.genAllocNodes nl req_nodes
+
   -- Run the tiered allocation, if enabled
 
   (case optTieredSpec opts of
@@ -299,7 +301,7 @@ main = do
            if stop_allocation
            then return result_noalloc
            else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
-                                  req_nodes [] [])
+                                  allocnodes [] [])
        let spec_map' = Cluster.tieredSpecMap trl_ixes
 
        printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
@@ -319,7 +321,7 @@ main = do
   (ereason, fin_nl, fin_il, ixes, _) <-
       if stop_allocation
       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
       sreason = reverse $ sortBy (comparing snd) ereason