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
131b1fb6
Commit
131b1fb6
authored
Nov 20, 2014
by
Yiannis Tsiouris
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix whitespace + add debugging info
parent
924e798d
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
27 additions
and
9 deletions
+27
-9
Bench.hs
Bench.hs
+19
-6
MasterWorker.hs
MasterWorker.hs
+8
-3
No files found.
Bench.hs
View file @
131b1fb6
...
@@ -4,12 +4,16 @@ module Bench( -- sequential benchmarks
...
@@ -4,12 +4,16 @@ module Bench( -- sequential benchmarks
,
par
,
par_seq
,
par
,
par_seq
-- distributed benhcmarks
-- distributed benhcmarks
,
dist
,
dist_seq
,
dist
,
dist_seq
,
seqTest
)
where
)
where
import
Control.Distributed.Process
(
Process
,
ProcessId
,
NodeId
)
import
Control.Concurrent
(
threadDelay
)
import
Control.Distributed.Process
import
Control.Distributed.Process.Node
import
Data.List
(
lookup
)
import
Data.List
(
lookup
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Maybe
(
fromMaybe
)
import
Prelude
hiding
(
seq
)
import
Prelude
hiding
(
seq
)
import
Network.Transport.TCP
import
MasterWorker
(
HostInfo
(
..
),
MaybeHosts
(
..
),
import
MasterWorker
(
HostInfo
(
..
),
MaybeHosts
(
..
),
MasterStats
,
orbit
)
MasterStats
,
orbit
)
...
@@ -59,3 +63,12 @@ sz (mainStats : _) =
...
@@ -59,3 +63,12 @@ sz (mainStats : _) =
case
"size"
`
lookup
`
mainStats
of
case
"size"
`
lookup
`
mainStats
of
Nothing
->
"false"
Nothing
->
"false"
Just
s
->
"{size,"
++
s
++
"}"
Just
s
->
"{size,"
++
s
++
"}"
seqTest
::
IO
()
seqTest
=
do
Right
t
<-
createTransport
"127.0.0.1"
"10504"
defaultTCPParameters
node
<-
newLocalNode
t
initRemoteTable
runProcess
node
$
do
res
<-
par
gg13
11
2
liftIO
$
print
res
threadDelay
(
2
*
1000000
)
MasterWorker.hs
View file @
131b1fb6
...
@@ -415,6 +415,7 @@ orbit gs xs (Par hostInfo) = par_orbit gs xs hostInfo
...
@@ -415,6 +415,7 @@ orbit gs xs (Par hostInfo) = par_orbit gs xs hostInfo
par_orbit
::
GenClos
->
[
Vertex
]
->
HostInfo
par_orbit
::
GenClos
->
[
Vertex
]
->
HostInfo
->
Process
([
Vertex
],
[
MasterStats
])
->
Process
([
Vertex
],
[
MasterStats
])
par_orbit
gs
xs
hosts
=
do
par_orbit
gs
xs
hosts
=
do
say
"---- in par_orbit"
-- spawn workers on Hosts
-- spawn workers on Hosts
(
workers
,
globTabSize
)
<-
start_workers
hosts
(
workers
,
globTabSize
)
<-
start_workers
hosts
self
<-
getSelfPid
self
<-
getSelfPid
...
@@ -445,7 +446,9 @@ par_orbit gs xs hosts = do
...
@@ -445,7 +446,9 @@ par_orbit gs xs hosts = do
-- * Workers is a list of Worker, sorted wrt. TableOffset in ascending order.
-- * Workers is a list of Worker, sorted wrt. TableOffset in ascending order.
start_workers
::
HostInfo
->
Process
([(
ProcessId
,
Int
,
Int
)],
Int
)
start_workers
::
HostInfo
->
Process
([(
ProcessId
,
Int
,
Int
)],
Int
)
start_workers
(
JustOne
host
)
=
do
start_workers
(
JustOne
host
)
=
do
say
"---- in start_workers"
(
workers
,
globalTableSize
)
<-
do_start_shm
host
(
[]
,
0
)
(
workers
,
globalTableSize
)
<-
do_start_shm
host
(
[]
,
0
)
say
"---- after do_start_shm"
return
(
reverse
workers
,
globalTableSize
)
return
(
reverse
workers
,
globalTableSize
)
start_workers
(
Many
hosts
)
=
do
start_workers
(
Many
hosts
)
=
do
(
workers
,
globalTableSize
)
<-
do_start_dist
hosts
(
[]
,
0
)
(
workers
,
globalTableSize
)
<-
do_start_dist
hosts
(
[]
,
0
)
...
@@ -455,8 +458,10 @@ do_start_shm :: (Int, Int, Int, Bool) -> ([(ProcessId, Int, Int)], Int)
...
@@ -455,8 +458,10 @@ do_start_shm :: (Int, Int, Int, Bool) -> ([(ProcessId, Int, Int)], Int)
->
Process
([(
ProcessId
,
Int
,
Int
)],
Int
)
->
Process
([(
ProcessId
,
Int
,
Int
)],
Int
)
do_start_shm
(
0
,
_
,
_
,
_
)
acc
=
return
acc
do_start_shm
(
0
,
_
,
_
,
_
)
acc
=
return
acc
do_start_shm
(
m
,
tabSize
,
tmOut
,
spawnImgComp
)
(
workers
,
gTabSize
)
=
do
do_start_shm
(
m
,
tabSize
,
tmOut
,
spawnImgComp
)
(
workers
,
gTabSize
)
=
do
selfNode
<-
getSelfNode
node
<-
getSelfNode
pid
<-
spawnLink
selfNode
(
$
(
mkClosure
'i
n
it
)
(
tabSize
,
tmOut
,
spawnImgComp
))
say
$
"---- i got a node id "
++
show
m
++
" "
++
show
tabSize
++
" "
++
show
tmOut
++
" "
++
show
workers
pid
<-
spawnLink
node
(
$
(
mkClosure
'i
n
it
)
(
tabSize
,
tmOut
,
spawnImgComp
))
say
"---- after spawnLink"
do_start_shm
(
m
-
1
,
tabSize
,
tmOut
,
spawnImgComp
)
do_start_shm
(
m
-
1
,
tabSize
,
tmOut
,
spawnImgComp
)
((
pid
,
gTabSize
,
tabSize
)
:
workers
,
gTabSize
+
tabSize
)
((
pid
,
gTabSize
,
tabSize
)
:
workers
,
gTabSize
+
tabSize
)
...
...
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