import Data.Char (toUpper, isAlphaNum)
import Data.List
-import Data.Function
import Data.Maybe (isJust, fromJust)
import Data.Ord (comparing)
import Monad
-- this should be the final entry
printKeys [("OK", "1")]
-formatRSpec :: String -> RSpec -> [(String, String)]
-formatRSpec s r =
+formatRSpec :: Double -> String -> RSpec -> [(String, String)]
+formatRSpec m_cpu s r =
[ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
+ , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
, ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
, ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
]
-printAllocationStats :: Node.List -> Node.List -> IO ()
-printAllocationStats ini_nl fin_nl = do
+printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
+printAllocationStats m_cpu ini_nl fin_nl = do
let ini_stats = Cluster.totalResources ini_nl
fin_stats = Cluster.totalResources fin_nl
(rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
- printKeys $ formatRSpec "USED" rini
- printKeys $ formatRSpec "POOL" ralo
- printKeys $ formatRSpec "UNAV" runa
+ printKeys $ formatRSpec m_cpu "USED" rini
+ printKeys $ formatRSpec m_cpu "POOL"ralo
+ printKeys $ formatRSpec m_cpu "UNAV" runa
-- | Ensure a value is quoted if needed
ensureQuoted :: String -> String
ispec = optISpec opts
shownodes = optShowNodes opts
- (fixed_nl, il, _) <- loadExternalData opts
+ (gl, fixed_nl, il, ctags) <- loadExternalData opts
printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
then return result_noalloc
else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
req_nodes [])
- let fin_trl_ixes = reverse trl_ixes
- ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
- spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
- ix_byspec::[(RSpec, Int)]
- spec_map' = map (\(spec, cnt) ->
- printf "%d,%d,%d=%d" (rspecMem spec)
- (rspecDsk spec) (rspecCpu spec) cnt)
- spec_map::[String]
+ let spec_map' = Cluster.tieredSpecMap trl_ixes
when (verbose > 1) $ do
hPutStrLn stderr "Tiered allocation map"
hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
- formatTable (map (printInstance trl_nl) fin_trl_ixes)
+ formatTable (map (printInstance trl_nl) (reverse trl_ixes))
[False, False, False, True, True, True]
when (isJust shownodes) $ do
when (isJust $ optSaveCluster opts) $
do
let out_path = (fromJust $ optSaveCluster opts) <.> "tiered"
- adata = serializeCluster trl_nl trl_il
+ adata = serializeCluster gl trl_nl trl_il ctags
writeFile out_path adata
hPrintf stderr "The cluster state after tiered allocation\
\ has been written to file '%s'\n"
out_path
printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
printKeys [("TSPEC", intercalate " " spec_map')]
- printAllocationStats nl trl_nl)
+ printAllocationStats m_cpu nl trl_nl)
-- Run the standard (avg-mode) allocation
when (isJust $ optSaveCluster opts) $
do
let out_path = (fromJust $ optSaveCluster opts) <.> "alloc"
- adata = serializeCluster fin_nl fin_il
+ adata = serializeCluster gl fin_nl fin_il ctags
writeFile out_path adata
hPrintf stderr "The cluster state after standard allocation\
\ has been written to file '%s'\n"