Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Contribute to GitLab
Sign in
Toggle navigation
C
cloud-orbit
Project
Project
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
Katerina Roukounaki
cloud-orbit
Commits
627fc2cb
Commit
627fc2cb
authored
Nov 20, 2014
by
Yiannis Tsiouris
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add -Wall and fix some warnings
parent
131b1fb6
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
60 additions
and
41 deletions
+60
-41
Bench.hs
Bench.hs
+2
-3
Makefile
Makefile
+1
-1
MasterWorker.hs
MasterWorker.hs
+41
-33
Sequential.hs
Sequential.hs
+1
-2
Utils.hs
Utils.hs
+15
-2
No files found.
Bench.hs
View file @
627fc2cb
...
...
@@ -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
)
Makefile
View file @
627fc2cb
.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
\
...
...
MasterWorker.hs
View file @
627fc2cb
...
...
@@ -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
cr
edi
t
table
statData
=
do
vertex_server
staticMachConf
cr
d
t
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
cr
edi
t
creditRetd
newCreditRetd
<-
return_credit
staticMachConf
cr
d
t
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
cr
edi
t
table
|
is_member
x
slot
table
=
return
(
cr
edi
t
,
table
)
-- x already in table;
-- do nothing
handle_vertex
staticMachConf
x
slot
cr
d
t
table
|
is_member
x
slot
table
=
return
(
cr
d
t
,
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
cr
edi
t
newCredit
<-
distribute_images
staticMachConf
x
cr
d
t
-- 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
cr
edi
t
creditRetd
|
is_zero
cr
edi
t
=
return
creditRetd
return_credit
staticMachConf
cr
d
t
creditRetd
|
is_zero
cr
d
t
=
return
creditRetd
|
otherwise
=
do
let
masterPid
=
get_master
staticMachConf
send
masterPid
(
"done"
,
cr
edi
t
)
send
masterPid
(
"done"
,
cr
d
t
)
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
cr
edi
t
=
do_distribute_images
staticMachConf
x
cr
edi
t
(
get_gens
staticMachConf
)
distribute_images
staticMachConf
x
cr
d
t
=
do_distribute_images
staticMachConf
x
cr
d
t
(
get_gens
staticMachConf
)
do_distribute_images
::
ParConf
->
Vertex
->
Credit
->
GenClos
->
Process
Credit
do_distribute_images
_
_
cr
edi
t
(
GenClos
(
_
,
_
,
[]
))
=
return
cr
edi
t
do_distribute_images
staticMachConf
x
cr
edi
t
(
GenClos
(
_
,
_
,
[
g
]))
=
do
let
(
k
,
remainingCredit
)
=
debit_atomic
cr
edi
t
do_distribute_images
_
_
cr
d
t
(
GenClos
(
_
,
_
,
[]
))
=
return
cr
d
t
do_distribute_images
staticMachConf
x
cr
d
t
(
GenClos
(
_
,
_
,
[
g
]))
=
do
let
(
k
,
remainingCredit
)
=
debit_atomic
cr
d
t
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
cr
edit
(
GenClos
(
_
,
_
,
g
:
gs
))
=
do
let
(
k
,
nonZeroRemainingCredit
)
=
debit_atomic_nz
cr
edi
t
do_distribute_images
staticMachConf
x
cr
dt
(
GenClos
(
name
,
n
,
g
:
gs
))
=
do
let
(
k
,
nonZeroRemainingCredit
)
=
debit_atomic_nz
cr
d
t
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_ve
tices
staticMachConf
credi
t
(
x
:
xs
)
=
do
let
(
k
,
nonZeroRemainingCredit
)
=
debit_atomic_nz
cr
edi
t
distribute_ve
rtices
staticMachConf
crd
t
(
x
:
xs
)
=
do
let
(
k
,
nonZeroRemainingCredit
)
=
debit_atomic_nz
cr
d
t
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
(
orb
it
,
stats
)
<-
do_collect_orbit
n
[]
[]
return
(
concat
orb
it
,
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
])
...
...
Sequential.hs
View file @
627fc2cb
...
...
@@ -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;
...
...
Utils.hs
View file @
627fc2cb
...
...
@@ -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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment