diff --git a/Bench.hs b/Bench.hs index 20245eed0ec6410ebda00ee6c54bd6684a5f081d..d188813f9b8b2f2b78aecfd98c965c56b871b0b4 100644 --- a/Bench.hs +++ b/Bench.hs @@ -10,8 +10,6 @@ module Bench( -- sequential benchmarks import Control.Concurrent (threadDelay) import Control.Distributed.Process import Control.Distributed.Process.Node -import Data.List (lookup) -import Data.Maybe (fromMaybe) import Prelude hiding (seq) import Network.Transport.TCP @@ -59,6 +57,7 @@ dist_seq generators n p workers = where w = length workers sz :: [MasterStats] -> String +sz [] = "false" sz (mainStats : _) = case "size" `lookup` mainStats of Nothing -> "false" @@ -71,4 +70,4 @@ seqTest = do runProcess node $ do res <- par gg13 11 2 liftIO $ print res - threadDelay (2 * 1000000) + threadDelay (1 * 1000000) diff --git a/Makefile b/Makefile index dd21e46c94922bffc715289a877ab50e722618e0..055975f66e04cfe6dd83e61d8f04cdb923ac2dd1 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ .PHONY: FORCE clean distclean orbit: FORCE - ghc --make Bench.hs -o orbit + ghc -Wall --make Bench.hs -o orbit tests: orbit ghc -package test-framework -package test-framework-hunit \ diff --git a/MasterWorker.hs b/MasterWorker.hs index e4db0f86905cdd783ffe2e01de0d61d66a8fc3d0..aaf7d446eb19d0860c15ab6321fdba21c0051ee6 100644 --- a/MasterWorker.hs +++ b/MasterWorker.hs @@ -32,8 +32,9 @@ import Prelude hiding (init) import Credit import qualified Sequential as Sq (orbit) import Table -import Utils (GenClos (..), Generator, - dispatcher, now) +import Utils (GenClos (..), + Generator, + now) -- counters/timers record data Ct = Ct { verts_recvd :: Int -- #vertices received by this server so far @@ -93,11 +94,11 @@ get_spawn_img_comp (_, _, _, _, _, spawmImgComp) = spawmImgComp set_idle_timeout :: ParConf -> Int -> ParConf -set_idle_timeout (gs, mst, wks, gts, timeout, spic) x = +set_idle_timeout (gs, mst, wks, gts, _, spic) x = (gs, mst, wks, gts, x, spic) clear_spawn_img_comp :: ParConf -> ParConf -clear_spawn_img_comp (gs, mst, wks, gts, tmt, spawmImgComp) = +clear_spawn_img_comp (gs, mst, wks, gts, tmt, _) = (gs, mst, wks, gts, tmt, False) -- produce readable statistics @@ -155,11 +156,12 @@ init (localTableSize, idleTimeout, spawnImgComp) = -- Table: hash table holding vertices -- StatData: various counters and timers for gathering statistics vertex_server :: ParConf -> Credit -> VTable -> Ct -> Process () -vertex_server staticMachConf credit table statData = do +vertex_server staticMachConf crdt table statData = do let idleTimeout = get_idle_timeout staticMachConf r <- receiveTimeout idleTimeout [ match $ \("vertex", x, slot, k) -> do - let creditPlusK = credit_atomic k credit + say $ "got a vertex!" + let creditPlusK = credit_atomic k crdt nowTime = now vertsRecvd = verts_recvd statData minAtomicCredit = min_atomic_credit statData @@ -185,7 +187,7 @@ vertex_server staticMachConf credit table statData = do ] case r of Nothing -> do let creditRetd = credit_retd statData - newCreditRetd <- return_credit staticMachConf credit creditRetd + newCreditRetd <- return_credit staticMachConf crdt creditRetd let newStatData = statData {credit_retd = newCreditRetd} vertex_server staticMachConf zero table newStatData Just _ -> return () @@ -196,24 +198,24 @@ vertex_server staticMachConf credit table statData = do -- Precondition: Credit is non-zero. handle_vertex :: ParConf -> Vertex -> Int -> Credit -> VTable -> Process (Credit, VTable) -handle_vertex staticMachConf x slot credit table - | is_member x slot table = return (credit, table) -- x already in table; - -- do nothing +handle_vertex staticMachConf x slot crdt table + | is_member x slot table = return (crdt, table) -- x already in table; + -- do nothing | otherwise = do -- x not in table let newTable = insert x slot table -- insert x at slot -- distribute images of x under generators to their respective workers - newCredit <- distribute_images staticMachConf x credit + newCredit <- distribute_images staticMachConf x crdt -- return remaining credit and updated table return (newCredit, newTable) -- return_credit sends non-zero Credit back to the master; -- returns number of times credit has been returned so far return_credit :: ParConf -> Credit -> Int -> Process Int -return_credit staticMachConf credit creditRetd - | is_zero credit = return creditRetd +return_credit staticMachConf crdt creditRetd + | is_zero crdt = return creditRetd | otherwise = do let masterPid = get_master staticMachConf - send masterPid ("done", credit) + send masterPid ("done", crdt) return (creditRetd + 1) -- dump_table sends a list containing the local partial orbit to the master, @@ -231,38 +233,40 @@ dump_table staticMachConf table statData = do -- computation and sending of vertices is actually done asynchronously. -- Precondition: Credit is non-zero. distribute_images :: ParConf -> Vertex -> Credit -> Process Credit -distribute_images staticMachConf x credit = - do_distribute_images staticMachConf x credit (get_gens staticMachConf) +distribute_images staticMachConf x crdt = + do_distribute_images staticMachConf x crdt (get_gens staticMachConf) do_distribute_images :: ParConf -> Vertex -> Credit -> GenClos -> Process Credit -do_distribute_images _ _ credit (GenClos (_, _, [])) = - return credit -do_distribute_images staticMachConf x credit (GenClos (_, _, [g])) = do - let (k, remainingCredit) = debit_atomic credit +do_distribute_images _ _ crdt (GenClos (_, _, [])) = + return crdt +do_distribute_images staticMachConf x crdt (GenClos (_, _, [g])) = do + let (k, remainingCredit) = debit_atomic crdt if get_spawn_img_comp staticMachConf then spawnLocal (send_image staticMachConf x g k) >> return () else send_image staticMachConf x g k return remainingCredit -do_distribute_images staticMachConf x credit (GenClos (_, _, g : gs)) = do - let (k, nonZeroRemainingCredit) = debit_atomic_nz credit +do_distribute_images staticMachConf x crdt (GenClos (name, n, g : gs)) = do + let (k, nonZeroRemainingCredit) = debit_atomic_nz crdt if get_spawn_img_comp staticMachConf then spawnLocal (send_image staticMachConf x g k) >> return () else send_image staticMachConf x g k - return nonZeroRemainingCredit + do_distribute_images staticMachConf x nonZeroRemainingCredit + (GenClos (name, n, gs)) -- distribute_vertices distributes the list of vertices Xs to the workers -- determined by the hash; some ore all of of the Credit is used to send -- the messages, the remaining credit is returned. -- Precondition: If Xs is non-empty then Credit must be non-zero. distribute_vertices :: ParConf -> Credit -> Credit -> Process Credit -distribute_vertices _ credit [] = return credit -distribute_vertices staticMachConf credit [x] = do - let (k, remainingCredit) = debit_atomic credit +distribute_vertices _ crdt [] = return crdt +distribute_vertices staticMachConf crdt [x] = do + let (k, remainingCredit) = debit_atomic crdt + say $ "remaining credit = " ++ show remainingCredit ++ " k = " ++ show k send_vertex staticMachConf x k return remainingCredit -distribute_vetices staticMachConf credit (x : xs) = do - let (k, nonZeroRemainingCredit) = debit_atomic_nz credit +distribute_vertices staticMachConf crdt (x : xs) = do + let (k, nonZeroRemainingCredit) = debit_atomic_nz crdt send_vertex staticMachConf x k distribute_vertices staticMachConf nonZeroRemainingCredit xs @@ -274,7 +278,7 @@ send_image staticMachConf x g k = send_vertex staticMachConf (g x) k -- send_vertex hashes vertex X and sends it to the worker determined by -- the hash; the message is tagged with atomic credit K. send_vertex :: ParConf -> Vertex -> ACredit -> Process () -send_vertex staticMachConf x k = send pid ("vertex", x, slot, k) +send_vertex staticMachConf x k = do {say $ "send to " ++ show (x, slot, k); send pid ("vertex", x, slot, k) } where (pid, slot) = hash_vertex staticMachConf x -- hash_vertex computes the two-dimensional hash table slot of vertex X where @@ -422,12 +426,16 @@ par_orbit gs xs hosts = do let -- assemble StaticMachConf and distribute to Workers staticMachConf = mk_static_mach_conf gs self workers globTabSize mapM_ (\(pid, _, _) -> send pid ("init", staticMachConf)) workers + say $ "---- after send pid init, xs = " ++ show xs let -- start wall clock timer startTime = now -- distribute initial vertices to workers - credit <- distribute_vertices staticMachConf one xs + crdt <- distribute_vertices staticMachConf one xs + say $ "---- after distribute_vertices, credit = " ++ show crdt + -- collect credit handed back by idle workers + collect_credit crdt + say "---- after collect credit" -- collect credit handed back by idle workers - collect_credit credit let -- measure elapsed time (in milliseconds) elapsedTime = now - startTime -- tell all workers to dump their tables @@ -487,8 +495,8 @@ collect_credit crdt -- collect_orbit collects partial orbits and stats from N workers. collect_orbit :: Int -> Int -> Process ([Vertex], [MasterStats]) collect_orbit elapsedTime n = do - (orbit, stats) <- do_collect_orbit n [] [] - return (concat orbit, master_stats elapsedTime stats : stats) + (orb, stats) <- do_collect_orbit n [] [] + return (concat orb, master_stats elapsedTime stats : stats) do_collect_orbit :: Int -> [[Vertex]] -> [WorkerStats] -> Process ([[Vertex]], [WorkerStats]) diff --git a/Sequential.hs b/Sequential.hs index 8ae8c4770d138b34c719621b0635a5f5bb5d1cac..672fb3d1055ec051bfdf0681c9deee52c89ef344 100644 --- a/Sequential.hs +++ b/Sequential.hs @@ -32,7 +32,7 @@ type SeqStats = [(String, String)] -- The function returns a pair consisting of the computed orbit and a singleton -- list of statistics (mainly runtime and fill degree of the table). orbit :: [Generator] -> [Vertex] -> Int -> ([Vertex], [SeqStats]) -orbit gs xs tableSize = (orbit, [stat]) +orbit gs xs tableSize = (to_list finalTable, [stat]) where -- assemble static configuration staticMachConf = mk_static_mach_conf gs tableSize -- initialise hash table and work queue @@ -45,7 +45,6 @@ orbit gs xs tableSize = (orbit, [stat]) -- measure elapsed time (in milliseconds) elapsedTime = now - startTime -- return result - orbit = to_list finalTable stat = seq_stats elapsedTime (get_freq finalTable) vertsRecvd -- main loop working off work Queue; diff --git a/Utils.hs b/Utils.hs index fe0ae3ef755e3a0acf8115e6487bcc1a27607a53..2a46726c059829ff4b9bf027ddbb6b65daceb699 100644 --- a/Utils.hs +++ b/Utils.hs @@ -9,7 +9,7 @@ newtype GenClos = GenClos (String, Int, [Generator]) deriving (Typeable) instance Show GenClos where - showsPrec p (GenClos (name, _, _)) = (name ++) + showsPrec _ (GenClos (name, _, _)) = (name ++) instance Binary GenClos where put (GenClos (name, n, _)) = put (name, n) @@ -68,6 +68,7 @@ r r0 n = (abs n) `rem` r0 -- f3 = fib(10..25), -- f4 = fib(11,19,27), bias 49- to 11, 49- to 19, 2- to 27 -- f5 = fib(10,20,30), bias 90- to 10, 9.9- to 20, 0.1- to 30 +f1, f2, f3, f4, f5 :: Int -> Int -> Int f1 n x = r n $ (fib (p3 1 0 (r 16 x))) + p3 1 0 x f2 n x = r n $ (fib (p3 1 5 (r 16 x))) + p4 2 5 (-1) x f3 n x = r n $ (fib (p3 1 10 (r 16 x))) + p5 (-1) 0 8 0 x @@ -75,9 +76,13 @@ f4 n x = r n $ (fib (p3 8 3 (s5 0 49 98 100 (r 100 x)))) + p2 (-1) x f5 n x = r n $ (fib (p3 10 0 (s5 0 900 999 1000 (r 1000 x)))) + p2 1 x -- sets (= lists) of generators +g :: Vertex -> [Generator] g _ = [] + +gg :: Vertex -> GenClos gg n = GenClos ("g", n, (g n)) +g1, g2, g3, g4, g5 :: Vertex -> [Generator] g1 n = [f1 n] g2 n = [f2 n] g3 n = [f3 n] @@ -91,6 +96,7 @@ gg3 n = GenClos ("g3", n, (g3 n)) gg4 n = GenClos ("g4", n, (g4 n)) gg5 n = GenClos ("g5", n, (g5 n)) +g12, g13, g14, g15, g23, g24, g25, g34, g35, g45 :: Vertex -> [Generator] g12 n = g1 n ++ g2 n g13 n = g1 n ++ g3 n g14 n = g1 n ++ g4 n @@ -102,7 +108,7 @@ g34 n = g3 n ++ g4 n g35 n = g3 n ++ g5 n g45 n = g4 n ++ g5 n -gg12, gg13, gg14, gg15, gg23, gg24, gg25 :: Vertex -> GenClos +gg12, gg13, gg14, gg15, gg23, gg24, gg25, gg34, gg35, gg45 :: Vertex -> GenClos gg12 n = GenClos ("g12", n, (g12 n)) gg13 n = GenClos ("g13", n, (g13 n)) gg14 n = GenClos ("g14", n, (g14 n)) @@ -110,7 +116,12 @@ gg15 n = GenClos ("g15", n, (g15 n)) gg23 n = GenClos ("g23", n, (g23 n)) gg24 n = GenClos ("g24", n, (g24 n)) gg25 n = GenClos ("g25", n, (g25 n)) +gg34 n = GenClos ("g34", n, (g34 n)) +gg35 n = GenClos ("g35", n, (g35 n)) +gg45 n = GenClos ("g45", n, (g45 n)) +g123, g124, g125, g134, g135, g145, g234, g235, g245, g345 + :: Vertex -> [Generator] g123 n = g12 n ++ g3 n g124 n = g12 n ++ g4 n g125 n = g12 n ++ g5 n @@ -135,6 +146,7 @@ gg235 n = GenClos ("g235", n, (g235 n)) gg245 n = GenClos ("g245", n, (g245 n)) gg345 n = GenClos ("g345", n, (g345 n)) +g1234, g1235, g1245, g1345, g2345 :: Vertex -> [Generator] g1234 n = g123 n ++ g4 n g1235 n = g123 n ++ g5 n g1245 n = g124 n ++ g5 n @@ -148,6 +160,7 @@ gg1245 n = GenClos ("g1245", n, (g1245 n)) gg1345 n = GenClos ("g1345", n, (g1345 n)) gg2345 n = GenClos ("g2345", n, (g2345 n)) +g12345 :: Vertex -> [Generator] g12345 n = g1234 n ++ g5 n gg12345 :: Vertex -> GenClos