diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs
index fbca04a5d2243b3f845d06e46e0390032f1e7ebc..42a91de5c74e05cf9beb2da1300c0427042192f1 100644
--- a/htools/Ganeti/HTools/Cluster.hs
+++ b/htools/Ganeti/HTools/Cluster.hs
@@ -1036,45 +1036,58 @@ tryNodeEvac _ ini_nl ini_il mode idxs =
 -- | Recursively place instances on the cluster until we're out of space.
 iterateAlloc :: Node.List
              -> Instance.List
+             -> Maybe Int
              -> Instance.Instance
              -> AllocNodes
              -> [Instance.Instance]
              -> [CStats]
              -> Result AllocResult
-iterateAlloc nl il newinst allocnodes ixes cstats =
+iterateAlloc nl il limit 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
+          newlimit = fmap (flip (-) 1) limit
       in case tryAlloc nl il newi2 allocnodes of
            Bad s -> Bad s
            Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
+               let newsol = Ok (collapseFailures errs, nl, il, ixes, cstats) in
                case sols3 of
-                 [] -> Ok (collapseFailures errs, nl, il, ixes, cstats)
+                 [] -> newsol
                  (xnl, xi, _, _):[] ->
-                     iterateAlloc xnl (Container.add newidx xi il)
-                                  newinst allocnodes (xi:ixes)
-                                  (totalResources xnl:cstats)
+                     if limit == Just 0
+                     then newsol
+                     else iterateAlloc xnl (Container.add newidx xi il)
+                          newlimit newinst allocnodes (xi:ixes)
+                          (totalResources xnl:cstats)
                  _ -> Bad "Internal error: multiple solutions for single\
                           \ allocation"
 
 -- | The core of the tiered allocation mode.
 tieredAlloc :: Node.List
             -> Instance.List
+            -> Maybe Int
             -> Instance.Instance
             -> AllocNodes
             -> [Instance.Instance]
             -> [CStats]
             -> Result AllocResult
-tieredAlloc nl il newinst allocnodes ixes cstats =
-    case iterateAlloc nl il newinst allocnodes ixes cstats of
+tieredAlloc nl il limit newinst allocnodes ixes cstats =
+    case iterateAlloc nl il limit newinst allocnodes ixes cstats of
       Bad s -> Bad s
       Ok (errs, nl', il', ixes', cstats') ->
+          let newsol = Ok (errs, nl', il', ixes', cstats')
+              ixes_cnt = length ixes'
+              (stop, newlimit) = case limit of
+                                   Nothing -> (False, Nothing)
+                                   Just n -> (n <= ixes_cnt,
+                                              Just (n - ixes_cnt)) in
+          if stop then newsol else
           case Instance.shrinkByType newinst . fst . last $
                sortBy (comparing snd) errs of
-            Bad _ -> Ok (errs, nl', il', ixes', cstats')
-            Ok newinst' ->
-                tieredAlloc nl' il' newinst' allocnodes ixes' cstats'
+            Bad _ -> newsol
+            Ok newinst' -> tieredAlloc nl' il' newlimit
+                           newinst' allocnodes ixes' cstats'
 
 -- | Compute the tiered spec string description from a list of
 -- allocated instances.
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index 4e38a31f1c7b683bea864251492ab791e518958e..56ba8be937cfb275262083d7b372609acf2564db 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -866,7 +866,7 @@ prop_ClusterCanTieredAlloc node inst =
         il = Container.empty
         allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
     in case allocnodes >>= \allocnodes' ->
-        Cluster.tieredAlloc nl il inst allocnodes' [] [] of
+        Cluster.tieredAlloc nl il (Just 1) inst allocnodes' [] [] of
          Types.Bad _ -> False
          Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
                                       IntMap.size il' == length ixes &&
@@ -909,7 +909,7 @@ prop_ClusterAllocBalance =
         allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
         i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
     in case allocnodes >>= \allocnodes' ->
-        Cluster.iterateAlloc nl' il i_templ allocnodes' [] [] of
+        Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
          Types.Bad _ -> False
          Types.Ok (_, xnl, il', _, _) ->
                    let ynl = Container.add (Node.idx hnode) hnode xnl
diff --git a/htools/hspace.hs b/htools/hspace.hs
index 6b1a613adcef7513ca4136cdb6232d43886a194e..dec1bf703b6a5b9dca43dcc19348f01c00d4dd6c 100644
--- a/htools/hspace.hs
+++ b/htools/hspace.hs
@@ -302,7 +302,7 @@ main = do
        (_, trl_nl, trl_il, trl_ixes, _) <-
            if stop_allocation
            then return result_noalloc
-           else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
+           else exitifbad (Cluster.tieredAlloc nl il Nothing (iofspec tspec)
                                   allocnodes [] [])
        let spec_map' = Cluster.tieredSpecMap trl_ixes
 
@@ -324,7 +324,8 @@ main = do
   (ereason, fin_nl, fin_il, ixes, _) <-
       if stop_allocation
       then return result_noalloc
-      else exitifbad (Cluster.iterateAlloc nl il reqinst allocnodes [] [])
+      else exitifbad (Cluster.iterateAlloc nl il Nothing
+                      reqinst allocnodes [] [])
 
   let allocs = length ixes
       sreason = reverse $ sortBy (comparing snd) ereason